1C
2C  THIS FILE CONTAINS THE GRAPHICS DEVICE SPECIFIC CODE.
3C
4C  THE FOLLOWING GRAPHICS DEVICES ARE SUPPORTED:
5C
6C   1. POSTSCRIPT    - POSTSCRIPT AND ENCAPSULATED POSTSCRIPT
7C                      DEVICES.
8C   2. X11           - X11 DEVICE.
9C   3. QUICKWIN      - QUICKWIN LIBRARY FOR INTEL COMPILER FOR
10C                      MICROSOFT WINDOWS.
11C   4. GD            - GD LIBRARY (FOR JPEG, PNG, GIF, TIFF, BMP).
12C   5. AQUA          - AQUATERM LIBRARY FOR MAC OSX.
13C   6. LATEX         - GENERATE GRAPHICS IN LATEX FORMAT.
14C   7. SVG           - SCALABLE VECTOR GRAPHICS FORMAT.
15C   8. LIBPLOT       - UNIX LIBPLOT LIBRARY.  SUPPORTS 14 DIFFERENT
16C                      DEVICES - 8 OF THESE ARE REDUNDANT TO DRIVERS
17C                      ALREADY SUPPORTED BY DATAPLOT, BUT 6 NEW FORMATS
18C                      (PNM BITMAP FORMAT, ADOBE ILLUSTRATOR, UNIX METAFILE
19C                      FORMAT, HP PCL PRINTER PROTOCOL, XFIG FORMAT, CGM)
20C                      ARE SUPPORTED.
21C   9. GENERAL       - DATAPLOT SPECIFIC METAFILE.  USED BY THE
22C                      TCL/TK GUI SCRIPTS.
23C  10. GENERAL CGM   - GGM METAFILE (ONLY ASCII IS SUPPORTED)
24C  11. CAIRO         - A GRAPHICS LIBRARY AVAILABLE ON LINUX/UNIX
25C                      PLATFORMS (E.G., USED BY FIREFOX).
26C                      CURRENTLY SUPPORTED ON LINUX FOR POSTSCRIPT, PDF
27C                      SVG, PNG, AND  X11.  THE QUARTZ AND WINDOWS GDI
28C                      ARE STILL UNDER DEVELOPMENT.
29C
30C  THE FOLLOWING ARE ESSENTIALLY OBSOLETE DEVICES.  SOME OF THESE
31C  MAY HAVE OCCASSIONAL USE AS AN EMULATION DEVICE.
32C
33C  12. TEKTRONIX     - MANY DIFFERENT TEKTRONIX MODELS ARE
34C                      SUPPORTED.  THIS IS AN ESSENTIALLY
35C                      OBSOLETE DEVICE.  IT MAY HAVE OCCASSIONAL
36C                      USE AS AN EMULATION DEVICE.
37C  13. HP            - SUPPORT 7221 PLOTTER, 2622, 2623, 2627
38C                      2647 TERMINALS.  THIS IS ESSENTIALLY AN
39C                      OBSOLETE DEVICE.
40C  14. HPGL          - HP HPGL PENPLOTTER PROTOCOL.
41C  15. CALCOMP       - CALCOMP LIBARARY.  THIS IS ESSENTIALLY
42C                      OBSOLETE, MAY HAVE OCCASSIONAL USE AS AN
43C                      EMULATION LIBRARY.
44C  16. ZETA          - A SLIGHT VARIATION OF CALCOMP THAT WAS
45C                      USED BY ZETA PENPLOTTERS
46C  17. SUN           - DRIVER FOR OLD SUN NEWS WINDOW SYSTEM.
47C  18. DEC REGIS     - VT125/VT340 TERMINALS.
48C  19. QUIC          - QUIC QMS PROTOCOL.
49C  20. TURB          - VGA DRIVER FOR TURBO-C (FOR ORIGINAL WINDOWS
50C                      GUI THAT WAS WRITTEN IN TURBO-C).
51C
52C  THE FOLLOWING ARE UNDER VARIOUS STAGES OF DEVELOPMENT.
53C
54C  21. GKS           - ANSI GKS STANDARD LIBRARY.  NOTE THAT THIS
55C                      DRIVER IS CODED, BUT NOT TESTED.  SINCE THE
56C                      GKS STANDARD WAS NOT WIDELY ADOPTED, THIS
57C                      USEFULNESS OF THIS DRIVER IS QUESTIONABLE.
58C                      THIS DRIVER IS NOT CURRENTLY BEING DEVELOPED
59C                      FURTHER.
60C  22. LAHEY         - LAHEY INTERACTOR AND LAHEY WININTERACTOR.
61C                      CODED, BUT NOT ACTIVE.  THESE LIBRARIES REQUIRE
62C                      DATAPLOT TO BE BUILT AS FULL BLOWN WINDOWS
63C                      APPLICATION, SO ADDITIONAL WORK NEEDS TO BE
64C                      DONE TO MAKE THESE ACTIVE DRIVERS.  THERE IS
65C                      ALSO AN OLD CALCOMP STYLE LIBRARY THAT WAS
66C                      USED WITH A VERY OLD VERSION OF THE LAHEY
67C                      COMPILER.  AS WE HAVE ADOPTED THE INTEL
68C                      COMPILER AS OUR MAIN DEVELOPMENT PLATFORM
69C                      UNDER WINDOWS, WE ARE NOT ACTIVELY DEVELOPING
70C                      THE WININTERACTOR DRIVER AS THIS TIME.
71C  23. OPEN-GL       - THIS DRIVER STILL UNDER DEVELOPMENT.  THIS WILL
72C                      BE AN IMPORTANT DRIVER IF WE WANT TO ADD
73C                      MORE HIGH PERFORMANCE VISUALIZATION CAPABILITIES.
74C  24. ABSOFT        - GRAPHICS LIBRARY SUPORTED BY ABSOFT COMPILER.
75C                      NOTE THAT THIS IS ACTUALLY THE PLPLOT LIBRARY
76C                      WHICH CAN BE USED INDEPENDENTLY OF THE ABSOFT
77C                      COMPILER.
78C
79C  THE FOLLOWING ARE CURRENTLY UNDER CONSIDERATION FOR ADDITION TO
80C  DATAPLOT.
81C
82C  25. VRML         - ALONG WITH OPEN-GL, WOULD BE USEFUL IF WE ADD
83C                     HIGH PERFORMANCE VISUALIZATION CAPABILITIES.
84C  26. WMF          - WINDOWS METAFILE
85C  27. D3           - D3 JAVASCRIPT LIBRARY
86C
87C  THE FOLLOWING ROUTINES TYPICALY NEED TO BE MODIFIED WHEN
88C  ADDING A NEW DEVICE DRIVER:
89C
90C  1. GRCLDE    - CLOSE THE DEVICE
91C  2. GRDRIM    - DRAW AN IMAGE
92C  3. GRDRLI    - DRAW A LINE BETWEEN TWO POINTS
93C  4. GRDRPH    - DRAW A HORIZONTAL POLYMARKER
94C  5. GRDRPL    - DRAW A POLYLINE
95C  6. GRERSC    - ERASE THE SCREEN
96C  7. GREXIT    - SHUT DOWN A DEVICE BEFORE EXITING DATAPLOT
97C  8. GRFIRE    - FILL A POLYGONAL REGION
98C  9. GRINDE    - INITIALIZE THE GRAPHICS DEVICE.
99C 10. GRMOBE    - PERFORM A MOVE
100C 11. GROPDE    - OPEN THE GRAPHICS DEVICE
101C 12. GRRESC    - READ THE SCREEN COORDINATES
102C 13. GRSAGR    - IMPLEMENT SAVE PLOT, REPEAT PLOT, CYCLE PLOT
103C 14. GRSECO    - SET THE COLOR
104C 15. GRSEPA    - SET THE PATTERN (I.E., LINE TYPE, FILL TYPE, ETC.)
105C 16. GRSEPP    - SET THE PICTURE POINTS FOR THE DEVICE
106C 17. GRSESI    - SET THE TEXT SIZE
107C 18. GRSETH    - SET THE LINE THICKNESS
108C 19. GRTRCO    - TRANSLATE THE COLOR
109C 20. GRTRPA    - TRANSLATE THE LINE OR FILL PATTERN
110C 21. GRTRSI    - TRANSLATE THE TEXT SIZE
111C 22. GRTTHI    - TRANSLATE THE LINE THICKNESS
112C 23. GRWRTH    - WRITE A HORIZONTAL TEXT STRING
113C 24. GRWRTV    - WRITE A VERTICAL TEXT STRING
114C
115C  THE FOLLOWING CODES TYPICALLY DO NOT REQUIRE UPDATING FOR
116C  A NEW GRAPHICS DEVICE (ALTHOUGH YOU MAY WANT TO ADD A
117C  PLACEHOLDER).
118C
119C  1. GRCOSC   - COPY THE SCREEN (BASICALLY OBSOLETE, PREVIOUSLY
120C                SUPPORTED OLD TEKTRONIX HARD COPY UNITS)
121C  2. GRDETH   - DETERMINE LENGTH OF HORIZONTAL TEXT STRING
122C  3. GRDETV   - DETERMINE LENGTH OF VERTICAL TEXT STRING
123C  4. GRRIBE   - RING THE BELL
124C  5. GRSECA   - SET THE TEXT CASE (LOWER/UPPER)
125C  6. GRSEDI   - SET THE TEXT DIRECTION
126C  7. GRSEFI   - SET THE FILL SPECIFICATION
127C  8. GRSEFO   - SET THE TEXT FONT
128C  9. GRSEJU   - SET THE TEXT JUSTIFICATION
129C 10. GRSEMO   - SET THE DEVICE MODE (GRAPHICS/DIALOGUE)
130C
131C  THE FOLLOWING CODES DO NOT CONTAIN ANY DEVICE SPECIFIC
132C  CODE.
133C
134C  1. GRTRCA   - TRANSLATE THE TEXT CASE (LOWER/UPPER)
135C  2. GRTRDI   - TRANSLATE THE TEXT DIRECTION
136C  3. GRTRFI   - TRANSLATE THE FILL SPECIFICATION
137C  4. GRTRFO   - TRANSLATE THE TEXT FONT
138C  5. GRTRJU   - TRANSLATE THE TEXT JUSTIFICATION
139C
140C  NOTE THAT SOME DRIVERS ARE NOT AVAILBLE ON ALL PLATFORMS.  THERE
141C  ARE TWO WAYS THAT WE ADDRESS THIS.
142C
143C   1. WE PROVIDE AN INTERMEDIATE LIBRARY.  CONDITIONAL COMPILATION
144C      IS USED TO SPECIFY WHETHER THE LIBRARY IS AVAILABLE.
145C
146C      THIS APPROACH IS CURRENTLY USED FOR
147C
148C      a. X11     HAVE_X11 = ON if X11 is available
149C      b. GD (for PNG, JPEG, GIF, TIFF, BMP, WEBP)
150C                 HAVE_GD = ON if GD is available
151C                 HAVE_TIFF = ON if Tiff library is available
152C                 HAVE_VPX = ON if VPX library (Webp format) is available
153C      c. AQUA    HAV_AQUA = ON if AquaTerm library is available
154C                            (MacOS only)
155C      d. libplot HAVE LIBPLOT = ON if libplot library is available
156C
157C   2. 2016/10: IMPLEMENT PLATFORM DEPENDENT DEVICES WITH PRE-PROCESSOR
158C               DIRECTIVES.  FOR EXAMPLE. "-DHAVE_CAIRO".  THIS AVOIDS
159C               HAVING TO PROVIDE DUMMY LIBRARIES.
160C
161      SUBROUTINE GRCLDE
162C
163C     PURPOSE--CLOSE A SPECIFIC GRAPHICS DEVICE
164C              THAT IS, TURN OFF A DEVICE WHICH IS
165C              CURRENTLY ON.
166C
167C     WRITTEN BY--JAMES J. FILLIBEN
168C                 STATISTICAL ENGINEERING DIVISION
169C                 INFORMATION TECHNOLOGY LABORATORY
170C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
171C                 GAITHERSBURG, MD 20899-8980
172C                 PHONE--301-975-2855
173C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
174C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
175C     LANGUAGE--ANSI FORTRAN (1977)
176C     VERSION NUMBER--83.6
177C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
178C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
179C                                      DRIVER OBSOLETE
180C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
181C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
182C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
183C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
184C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
185C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
186C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
187C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
188C                                      DRIVER OBSOLETE
189C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
190C                                      OLD STYLE CALCOMP
191C                                      DRIVER OBSOLETE
192C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
193C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
194C                                      USE BILL MITCHELLS OPENGL
195C                                      BINDING FOR FORTRAN
196C     UPDATED         --OCTOBER  1996. GKS (ALAN)
197C                                      CODED, NOT TESTED
198C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
199C                                      PLACEHOLDER FOR NOW
200C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
201C                                      PLACEHOLDER FOR NOW
202C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
203C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
204C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
205C     UPDATED         --JUNE     2000. MACINTOSH
206C                                      PLACEHOLDER FOR NOW
207C     UPDATED         --JUNE     2000. PC PRINTER
208C                                      PLACEHOLDER FOR NOW
209C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
210C                                      PLACEHOLDER FOR NOW
211C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
212C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
213C     UPDATED         --FEBRUARY 2006. IMPLEMENT LATEX DRIVER
214C     UPDATED         --APRIL    2009. IMPLEMENT LIBPLOT DRIVER
215C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
216C                                      (THESE WERE NEVER ACTUALLY IMPLENENTED)
217C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
218C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
219C                                      DEVICE DRIVERS (CAIRO, WMF, D3)
220C
221C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
222C
223#ifdef HAVE_WININTERACTER
224      USE WINTERACTER
225#endif
226#ifdef HAVE_INTERACTER
227      USE INTERACTER
228#endif
229CQWIN USE DFLIB
230#ifdef HAVE_QWIN
231      USE IFQWIN
232#endif
233C
234      CHARACTER*130 ICSTR
235CCCCC CHARACTER*130 IATEMP
236      CHARACTER*4 ISUBN0
237      CHARACTER*1 IA
238C
239C     FOLLOWING LINES FOR LATEX CODE THAT IS CURRENTLY
240C     COMMENTED OUT.
241C
242CCCCC CHARACTER*80 IFILE1
243CCCCC CHARACTER*12 ISTAT1
244CCCCC CHARACTER*12 IFORM1
245CCCCC CHARACTER*12 IACCE1
246CCCCC CHARACTER*12 IPROT1
247CCCCC CHARACTER*12 ICURS1
248CCCCC CHARACTER*4 IENDF1
249CCCCC CHARACTER*4 IREWI1
250CCCCC CHARACTER*4 IERRF1
251C
252C-----COMMON----------------------------------------------------------
253C
254      INCLUDE 'DPCOPA.INC'
255      INCLUDE 'DPCOGR.INC'
256      INCLUDE 'DPCONP.INC'
257      INCLUDE 'DPCOBE.INC'
258      INCLUDE 'DPCODV.INC'
259      INCLUDE 'DPCOST.INC'
260      INCLUDE 'DPCOF2.INC'
261CCCCC INCLUDE 'DPCOFO.INC'
262      INCLUDE 'DPCOP2.INC'
263C
264C-----START POINT-----------------------------------------------------
265C
266      ISUBN0='CLDE'
267      IERRG4='NO'
268C
269      NCSTR=(-999)
270C
271      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CLDE')THEN
272        WRITE(ICOUT,999)
273  999   FORMAT(1X)
274        CALL DPWRST('XXX','BUG ')
275        WRITE(ICOUT,51)
276   51   FORMAT('***** AT THE BEGINNING OF GRCLDE--')
277        CALL DPWRST('XXX','BUG ')
278        WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3
279   52   FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',3(A4,2X),A4)
280        CALL DPWRST('XXX','BUG ')
281        WRITE(ICOUT,53)IGUNIT,IGBAUD,IGCODE
282   53   FORMAT('IGUNIT,IGBAUD,IGCODE = ',2I8,2X,A4)
283        CALL DPWRST('XXX','BUG ')
284        WRITE(ICOUT,54)ISOFT,ISOFT2,ISOFT3
285   54   FORMAT('ISOFT,ISOFT2,ISOFT3 = ',2(A4,2X),A4)
286        CALL DPWRST('XXX','BUG ')
287        WRITE(ICOUT,56)IBUGG4,ISUBG4,IERRG4
288   56   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',2(A4,2X),A4)
289        CALL DPWRST('XXX','BUG ')
290        WRITE(ICOUT,61)IPPDE1,IPPDE2,NCPOST
291   61   FORMAT('IPPDE1,IPPDE2,NCPOST = ',2(A4,2X),I8)
292        CALL DPWRST('XXX','BUG ')
293        IF(NCPOST.GE.1)THEN
294          DO63I=1,NCPOST
295            WRITE(ICOUT,64)I,ICPOST(I:I)
296   64       FORMAT('I,ICPOST(I:I) = ',I8,2X,A1,4X)
297            CALL DPWRST('XXX','BUG ')
298   63     CONTINUE
299        ENDIF
300      ENDIF
301C
302C               ********************************************
303C               **  STEP 1--                              **
304C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
305C               **  AND THE MODEL                         **
306C               ********************************************
307C
308      IF(IMANUF.EQ.'QWIN')THEN
309        GOTO4700
310      ELSEIF(IMANUF.EQ.'POST')THEN
311        GOTO8600
312      ELSEIF(IMANUF.EQ.'X11 ')THEN
313        GOTO9600
314      ELSEIF(IMANUF.EQ.'AQUA')THEN
315        GOTO13500
316      ELSEIF(IMANUF.EQ.'GENE')THEN
317        IF(IMODEL.EQ.'CODE')GOTO3200
318        IF(IMODEL.EQ.'CGM')GOTO3300
319        IF(IMODEL.EQ.'CGMB')GOTO3400
320        GOTO3100
321      ELSEIF(IMANUF.EQ.'SVG ')THEN
322        GOTO16000
323      ELSEIF(IMANUF.EQ.'GD  ')THEN
324        GOTO12000
325      ELSEIF(IMANUF.EQ.'LATE')THEN
326        GOTO15000
327      ELSEIF(IMANUF.EQ.'CAIR')THEN
328        GOTO17000
329      ELSEIF(IMANUF.EQ.'D3  ')THEN
330        GOTO19000
331      ELSEIF(IMANUF.EQ.'WMF ')THEN
332        GOTO18000
333      ELSEIF(IMANUF.EQ.'OPGL')THEN
334        GOTO4800
335      ELSEIF(IMANUF.EQ.'D3  ')THEN
336        GOTO19000
337      ELSEIF(IMANUF.EQ.'TEKT')THEN
338        GOTO1100
339      ELSEIF(IMANUF.EQ.'HP')THEN
340        IF(IMODEL.EQ.'7221')GOTO2100
341        IF(IMODEL.EQ.'2622')GOTO2300
342        IF(IMODEL.EQ.'2623')GOTO2300
343        IF(IMODEL.EQ.'2627')GOTO2300
344        IF(IMODEL.EQ.'2647')GOTO2300
345        GOTO2200
346      ELSEIF(IMANUF.EQ.'LIBP')THEN
347        GOTO2600
348      ELSEIF(IMANUF.EQ.'REGI')THEN
349        GOTO8100
350      ELSEIF(IMANUF.EQ.'GKS ')THEN
351        GOTO11000
352      ELSEIF(IMANUF.EQ.'LAHE')THEN
353        IF(IMODEL.EQ.'INTE')GOTO4900
354        IF(IMODEL.EQ.'WINT')GOTO4950
355        GOTO4600
356      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
357        GOTO13000
358      ELSEIF(IMANUF.EQ.'QUIC')THEN
359        GOTO9100
360      ELSEIF(IMANUF.EQ.'CALC')THEN
361        GOTO4100
362      ELSEIF(IMANUF.EQ.'ZETA')THEN
363        GOTO5100
364      ELSEIF(IMANUF.EQ.'TURB')THEN
365        GOTO10000
366      ELSEIF(IMANUF.EQ.'SUN ')THEN
367        GOTO6600
368      ENDIF
369      GOTO9000
370C
371C               ******************************************************
372C               **  STEP 11--                                       **
373C               **  TREAT THE TEKTRONIX 4662 CASE (A PENPLOTTER)--  **
374C               **  TO TURN IT OFF,                                 **
375C               **  WRITE OUT AN ESCAPE A F  .                      **
376C               ******************************************************
377C
378 1100 CONTINUE
379      IF(IMODEL.EQ.'4662')THEN
380        ICSTR(1:1)=IESCC
381        ICSTR(2:3)='AF'
382        NCSTR=3
383        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
384      ENDIF
385C
386      IF(IPPDE1.EQ.'TEKT')GOTO8910
387      GOTO8900
388C
389C               ******************************************************
390C               **  STEP 21--                                       **
391C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
392C               **  (MULTI-COLOR PENPLOTTER)                        **
393C               **  TO TURN IT OFF,                                 **
394C               **  SEND ESCAPE PERIOD RIGHT-PARENTHESIS            **
395C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
396C               **             OPERATING AND PROGRAMMING MANUAL,    **
397C               **             PAGE 72.                             **
398C               ******************************************************
399C
400 2100 CONTINUE
401      ICSTR(1:1)='+'
402      ICSTR(2:2)=IESCC
403      ICSTR(3:4)='.)'
404      ICSTR(5:5)=IESCC
405      ICSTR(6:8)='.Z:'
406      NCSTR=8
407      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
408C
409      IF(IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'7221')GOTO8910
410      GOTO8900
411C
412C               ******************************************************
413C               **  STEP 22--                                       **
414C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
415C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
416C               **  (MULTI-COLOR PENPLOTTERS)                       **
417C               **  THERE IS NO    TURN OFF   INSTRUCTION PER SE,   **
418C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
419C               **             OPERATING AND PROGRAMMING MANUAL,    **
420C               **             PAGE XX, XXX.                        **
421C               ******************************************************
422C
423 2200 CONTINUE
424C
425C     THE FOLLOWING WAS A SUGGESTED AUGMENTATION (NBS'S YONG-KI KIM,
426C     MARCH, 1985).  WHEN THE PLOTTER IS CONNECTED IN SERIES BETWEEN THE
427C     HOST AND THE TERMINAL, AND THE PLOTTER NEEDS TO BE PUT IN A
428C     LISTEN-AND-CAPTURE MODE WHEN GENERATING A PLOT.  TO SPECIFY THIS,
429C     THE ANALYST ENTERS THE COMMAND        HP-GL +    RATHER THAN THE USUAL
430C     HP-GL.
431C
432      IF(IPPDE1.EQ.'HPGL' .OR. IPPDE1.EQ.'HP-G' .OR.
433     1  (IPPDE1.EQ.'HP'.AND.IPPDE2.EQ.'GL') .OR.
434     1  (IPPDE1.EQ.'HP'.AND.IPPDE2.EQ.'GL+'))THEN
435        GOTO8910
436      ENDIF
437      GOTO8900
438C
439C               **********************************************************
440C               **  STEP 23--                                           **
441C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
442C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
443C               **  (MONOCHROME DISPLAY TERMINALS)                      **
444C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
445C               **             REFERENCE MANUAL,                        **
446C               **             PAGE XX-X, XXX.                          **
447C               **********************************************************
448C
449 2300 CONTINUE
450      IF((IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2622') .OR.
451     1   (IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2623') .OR.
452     1   (IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2627') .OR.
453     1   (IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2647'))THEN
454        GOTO8910
455      ENDIF
456      GOTO8900
457C
458C               **********************************************************
459C               **  STEP 26--                                           **
460C               **  TREAT THE UNIX LIBPLOT CASE.                        **
461C               **********************************************************
462C
463 2600 CONTINUE
464      GOTO9000
465C
466C               ******************************************************
467C               **  STEP 31--                                       **
468C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
469C               ******************************************************
470C
471 3100 CONTINUE
472      ICSTR(1:12)='CLOSE DEVICE'
473      NCSTR=12
474      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
475C
476      IF(IPPDE1.EQ.'GENE')GOTO8910
477      GOTO8900
478C
479C               ***************************************************************
480C               **  STEP 32--                                                **
481C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
482C               ***************************************************************
483C
484 3200 CONTINUE
485      ICSTR(1:4)='CLDE'
486      NCSTR=4
487      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
488C
489      IF(IPPDE1.EQ.'CODE')GOTO8910
490      GOTO8900
491C
492C               ***************************************************************
493C               **  STEP 33--                                                **
494C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
495C               ***************************************************************
496C
497 3300 CONTINUE
498C
499      IF(IPPDE1.EQ.'CODE')GOTO8910
500      GOTO8900
501C
502C               ***************************************************
503C               **  STEP 34--                                    **
504C               **  TREAT THE CGM (BINARY)                 CASE  **
505C               ***************************************************
506C
507 3400 CONTINUE
508      GOTO9000
509C
510C               ******************************************************
511C               **  STEP 41--                                       **
512C               **  TREAT THE CALCOMP XXXXXX CASE                   **
513C               **  TO TURN IT OFF--                                **
514C               **  WRITE OUT AN XXXXXXXXXXXXXX                     **
515C               **  USE CALCOMP LIBRARY (NULL ROUTINE)              **
516C               **  REFERENCE--XX                                   **
517C               **             XX                                   **
518C               **             PAGES XX AND XX                      **
519C               ******************************************************
520C
521 4100 CONTINUE
522      GOTO8900
523C
524C               ******************************************************
525C               **  STEP 46--                                       **
526C               **  TREAT THE LAHEY   XXXXXX CASE                   **
527C               **  TO TURN IT OFF--                                **
528C               **  CALL PLOT WITH IPEN=999                         **
529C               **  ONLY CALL IF ILAHCL = 'ON'                      **
530C               **  REFERENCE--Programmer's Reference, Revision C   **
531C               **             Lahey Computer Systems, January, 1992**
532C               **             PAGES 51 THRU 65                     **
533C               ******************************************************
534C
535 4600 CONTINUE
536C
537C  ILAHCL  = IF ON, RETURN TO VIDEO TEXT MODE.  THIS IS PREFERRED
538C            CHOICE FOR BETTER ALPHANUMERIC OUTPUT.  HOWEVER, MAY WANT
539C            TO LEAVE IN GRAPHICS MODE TO GENERATE DIAGRAMMATIC GRAPHICS
540C  ILAHPA  = IF ON, REQUEST A CARRIAGE RETURN BEFORE CONTINUING.  IF
541C            OFF, CONTINUE REGARDLESS.
542C  ILAHSW  = ON IF GRAPHICS MODE SET, OFF IF NORMAL VIDEO MODE SET
543C
544      IF(ILAHPA.EQ.'ON')THEN
545        WRITE(IPR,4601)
546 4601   FORMAT(1X,'ENTER CARRIAGE RETURN TO CONTINUE')
547        READ(IRD,'(1X,A1)')IA
548      ENDIF
549      IF(ILAHCL.EQ.'ON')THEN
550        AX=0.
551        AY=0.
552        IPEN=999
553#ifdef HAVE_LAHEY_CALCOMP
554        IF(ILAHSW.EQ.'ON')CALL PLOT(AX,AY,IPEN)
555#endif
556        ILAHSW='OFF'
557      ENDIF
558      GOTO8900
559C
560C               ******************************************************
561C               **  STEP 47--                                       **
562C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
563C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
564C               ******************************************************
565C
566 4700 CONTINUE
567      IF(IQWNFC.EQ.'TEXT')THEN
568#ifdef HAVE_QWIN
569        IRESLT=FOCUSQQ(IPR)
570        IRESLT=DISPLAYCURSOR($GCURSORON)
571#endif
572      ENDIF
573      GOTO9000
574C
575C               ******************************************************
576C               **  STEP 48--                                       **
577C               **  TREAT THE OPEN-GL DRIVER                        **
578C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
579C               ******************************************************
580C
581 4800 CONTINUE
582      IFLAG=1
583#ifdef HAVE_OPENGL
584      CALL GLCLDE()
585#endif
586      GOTO9000
587C
588C               ******************************************************
589C               **  STEP 49--                                       **
590C               **  TREAT THE LAHEY INTERACTOR CASE                 **
591C               ******************************************************
592C
593 4900 CONTINUE
594      GOTO9000
595C
596C               ******************************************************
597C               **  STEP 49B-                                       **
598C               **  TREAT THE LAHEY WINTERACTOR CASE                **
599C               ******************************************************
600C
601 4950 CONTINUE
602      IHAND1=0
603#ifdef HAVE_LAHEY_WINTERACTOR
604      CALL WindowSelect(IHAND1)
605#endif
606      GOTO9000
607C
608C               ******************************************************
609C               **  STEP 51--                                       **
610C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
611C               **  TO TURN IT OFF--                                **
612C               **  WRITE OUT    70Z                                **
613C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
614C               **             MODELS 3600SX AND 3653SX             **
615C               **             PAGES B-0 AND B-1                    **
616C               **  USE CALCOMP LIBRARY (NULL ROUTINE)              **
617C               ******************************************************
618C
619 5100 CONTINUE
620CCCCC WRITE(IGUNIT,5111)
621C5111 FORMAT('70Z')
622CCCCC ICSTR(1:3)='70Z'
623CCCCC NCSTR=3
624CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
625      GOTO8900
626C
627C               ******************************************************
628C               **  STEP 66--                                       **
629C               **  TREAT THE SUN CASE                              **
630C               **  NOT NECESSARY TO CLOSE DEVICE                   **
631C               ******************************************************
632C
633 6600 CONTINUE
634      IF(IPPDE1.EQ.'SUN')GOTO8910
635      GOTO9000
636C
637C               ******************************************************
638C               **  STEP 81--                                       **
639C               **  TREAT THE DEC  REGIS CASE                       **
640C               **  TO CLOSE DEVICE---                              **
641C               **  WRITE OUT AN XX                                 **
642C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
643C               **             PAGES XX AND XX                      **
644C               ******************************************************
645C
646 8100 CONTINUE
647      IF(IPPDE1.EQ.'REGI')GOTO8910
648      GOTO8900
649C
650C               ******************************************************
651C               **  STEP 86--                                       **
652C               **  TREAT THE POSTSCRIPT CASE                       **
653C               **  REFERENCE: POSTSCRIPT LANGUAGE TUTORIAL AND     **
654C               **  COOKBOOK FROM ADOBE SYSTEMS                     **
655C               ******************************************************
656C
657 8600 CONTINUE
658C
659      IF(IPPDE1.EQ.'POST')GOTO8910
660      GOTO8900
661C
662C               ******************************************************
663C               **  STEP 91--                                       **
664C               **  TREAT THE QUIC CASE - NULL ROUTINE              **
665C               ******************************************************
666C
667 9100 CONTINUE
668C
669      IF(IPPDE1.EQ.'QUIC')GOTO8910
670      GOTO8900
671C
672C               ******************************************************
673C               **  STEP 96--                                       **
674C               **  TREAT THE X11     CASE - FLUSH THE BUFFER       **
675C               **  REFERENCE--DDC SOFTWARE TRANSLATOR MANUAL       **
676C               ******************************************************
677C
678 9600 CONTINUE
679C
680#ifdef HAVE_X11
681      IF(IX11OF.NE.'OFF')CALL XCLEAR
682      IF(IPPDE1.EQ.'X11 ')GOTO8910
683#endif
684      GOTO8900
685C
686CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
687C               *************************************************
688C               **  STEP 100--                                 **
689C               **  TREAT THE VGA VIA TURBO-C       CASE       **
690C               *************************************************
691C
692C     NOTE: THIS ROUTINE NO LONGER ACTIVE, SO COMMENT OUT.
69310000 CONTINUE
694CTURB CALL TCCLDE
695      GOTO9000
696C
697C               ******************************************************
698C               **  STEP 110--                                      **
699C               **  TREAT THE GKS                DRIVER             **
700C               ******************************************************
701C
70211000 CONTINUE
703#ifdef HAVE_GKS
704      CALL GDAWK(IGKSWK)
705#endif
706      GOTO9000
707C
708C               ******************************************************
709C               **  STEP 120--                                      **
710C               **  TREAT THE GD                     DRIVER         **
711C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
712C               **  1) JPEG                                         **
713C               **  2) PNG                                          **
714C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
715C               ******************************************************
716C
71712000 CONTINUE
718      GOTO9000
719C
720C               ******************************************************
721C               **  STEP 130--                                      **
722C               **  TREAT THE ABSOFT                 DRIVER         **
723C               **  LIBRARY FROM ABSOFT COMPILER                    **
724C               ******************************************************
725C
72613000 CONTINUE
727      GOTO9000
728C
729C               ******************************************************
730C               **  STEP 135--                                      **
731C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
732C               ******************************************************
733C
73413500 CONTINUE
735#ifdef HAVE_AQUA
736COLD  CALL aqtRenderPlot()
737      CALL aqrend()
738#endif
739      GOTO9000
740C
741C               ******************************************************
742C               **  STEP 150--                                      **
743C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
744C               ******************************************************
745C
74615000 CONTINUE
747C
748CCCCC ICSTR(1:1)=IBASLC
749CCCCC ICSTR(2:13)='end{picture}'
750CCCCC NCSTR=13
751CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
752C
753CCCCC IF(IMODEL.NE.'STAN')THEN
754C
755CCCCC   ICSTR(1:1)=' '
756CCCCC   NCSTR=1
757CCCCC   CALL GRWRST(ICSTR,NCSTR,ISUBN0)
758C
759CCCCC   ICSTR(1:1)=IBASLC
760CCCCC   ICSTR(2:18)='begin{verbatim}'
761CCCCC   NCSTR=18
762CCCCC   CALL GRWRST(ICSTR,NCSTR,ISUBN0)
763C
764CCCCC ELSEIF(ILATFO.EQ.'NULL')THEN
765C
766CCCCC   ICSTR(1:1)=' '
767CCCCC   NCSTR=1
768CCCCC   CALL GRWRST(ICSTR,NCSTR,ISUBN0)
769C
770CCCCC   ICSTR(1:1)=IBASLC
771CCCCC   ICSTR(2:16)='end{document}'
772CCCCC   NCSTR=16
773CCCCC   CALL GRWRST(ICSTR,NCSTR,ISUBN0)
774C
775CCCCC ELSE
776CCCCC   IOUNI1=IST1NU
777CCCCC   IFILE1=ILATFO
778CCCCC   ISTAT1='OLD'
779CCCCC   IFORM1='FORMATTED'
780CCCCC   IACCE1='SEQUENTIAL'
781CCCCC   IPROT1='READONLY'
782CCCCC   ICURS1='CLOSED'
783CCCCC   ISUBN0='CAPT'
784CCCCC   IERRF1='NO'
785C
786CCCCC   IREWI1='ON'
787CCCCC   CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
788CCCCC1                IREWI1,ISUBN0,IERRF1,IBUGS2,ISUBRO,IERROR)
789CCCCC   IF(IERRF1.EQ.'YES')GOTO9000
790C
791C  NOW LOOP THROUGH FILE (ASSUME MAXIMUM OF 1,000 LINES).
792C
793CCCCC   DO15301I=1,1000
794CCCCC     IATEMP=' '
795CCCCC     READ(IOUNI1,15392,END=15399,ERR=15399)IATEMP
796C15392     FORMAT(A240)
797CCCCC     ILAST=1
798CCCCC     DO15410J=240,1,-1
799CCCCC       IF(IATEMP(J:J).NE.' ')THEN
800CCCCC         ILAST=J
801CCCCC         GOTO15419
802CCCCC       ENDIF
803C15410     CONTINUE
804C15419     CONTINUE
805CCCCC     ICSTR(1:ILAST)=IATEMP(1:ILAST)
806CCCCC     NCSTR=ILAST
807CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
808C15301   CONTINUE
809C15399   CONTINUE
810CCCCC   IENDF1='OFF'
811CCCCC   IREWI1='ON'
812CCCCC   CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
813CCCCC1                IENDF1,IREWI1,ISUBN0,IERRF1,IBUGS2,ISUBRO,IERROR)
814CCCCC   IF(IERRF1.EQ.'YES')GOTO9000
815CCCCC ENDIF
816      GOTO9000
817C
818C               ******************************************************
819C               **  STEP 160--                                      **
820C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
821C               ******************************************************
822C
82316000 CONTINUE
824      GOTO9000
825C
826C               ******************************************************
827C               **  STEP 170--                                      **
828C               **  TREAT THE CAIRO                          DRIVER **
829C               ******************************************************
830C
83117000 CONTINUE
832      IVAL1=0
833      IF(IMODEL.EQ.'X11')IVAL1=1
834      IF(IMODEL.EQ.'POST')IVAL1=2
835      IF(IMODEL.EQ.'PDF')IVAL1=3
836      IF(IMODEL.EQ.'SVG')IVAL1=4
837      IF(IMODEL.EQ.'QUAR')IVAL1=5
838      IF(IMODEL.EQ.'PNG')IVAL1=6
839      IF(IMODEL.EQ.'WIND')IVAL1=7
840      IF(IMODEL.EQ.'EPS')IVAL1=8
841      IVAL2=1
842      IF(IGUNIT.EQ.IPL1NU)IVAL2=2
843      IF(IGUNIT.EQ.IPL2NU)IVAL2=3
844#ifdef HAVE_CAIRO
845      CALL CAFLSH(IVAL2,IVAL1)
846#endif
847      GOTO9000
848C
849C               ******************************************************
850C               **  STEP 180--                                      **
851C               **  TREAT THE WMF                            DRIVER **
852C               ******************************************************
853C
85418000 CONTINUE
855      GOTO9000
856C
857C               ******************************************************
858C               **  STEP 190--                                      **
859C               **  TREAT THE D3                             DRIVER **
860C               ******************************************************
861C
86219000 CONTINUE
863      GOTO9000
864C
865C               ********************************************
866C               **  STEP 89--                             **
867C               **  IF CALLED FOR, WRITE OUT              **
868C               **  A USER-DEFINED POST-PLOT LINE         **
869C               ********************************************
870C
871 8900 CONTINUE
872      IF(IPPDE1.EQ.'ANY' .OR. IPPDE1.EQ.'ALL')THEN
873        IF(NCPOST.GE.1)THEN
874          NCSTR=NCPOST
875          IF(NCSTR.GT.40)NCSTR=40
876          ICSTR(1:NCSTR)=ICPOST(1:NCSTR)
877          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
878        ENDIF
879      ENDIF
880C
881C               ********************************************
882C               **  STEP 891-                             **
883C               **  IF CALLED FOR, WRITE OUT              **
884C               **  A USER-DEFINED POST-PLOT LINE         **
885C               ********************************************
886C
887 8910 CONTINUE
888      IF(NCPOST.GE.1)THEN
889        NCSTR=NCPOST
890        IF(NCSTR.GT.40)NCSTR=40
891        ICSTR(1:NCSTR)=ICPOST(1:NCSTR)
892        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
893      ENDIF
894      GOTO9000
895C
896C               *****************
897C               **  STEP 90--  **
898C               **  EXIT       **
899C               *****************
900C
901 9000 CONTINUE
902      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'CLDE')THEN
903        WRITE(ICOUT,999)
904        CALL DPWRST('XXX','BUG ')
905        WRITE(ICOUT,9011)
906 9011   FORMAT('***** AT THE END       OF GRCLDE--')
907        CALL DPWRST('XXX','BUG ')
908        WRITE(ICOUT,9023)IPPDE1,IPPDE2,NCSTR,NCPOST
909 9023   FORMAT('IPPDE1,IPPDE2,NCSTR,NCPOST = ',2(A4,2X),2I5)
910        CALL DPWRST('XXX','BUG ')
911        IF(NCSTR.GE.1)THEN
912          DO9025I=1,NCSTR
913            CALL DPCOAN(ICSTR(I:I),IASCNE)
914            WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
915 9026       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
916            CALL DPWRST('XXX','BUG ')
917 9025     CONTINUE
918        ENDIF
919        IF(NCPOST.GE.1)THEN
920          DO9033I=1,NCPOST
921            WRITE(ICOUT,9034)I,ICPOST(I:I)
922 9034       FORMAT('I,ICPOST(I:I) = ',I8,2X,A1,4X)
923            CALL DPWRST('XXX','BUG ')
924 9033     CONTINUE
925        ENDIF
926      ENDIF
927C
928      RETURN
929      END
930      SUBROUTINE GRCOSC
931C
932C     PURPOSE--COPY THE SCREEN OF A SPECIFIC GRAPHICS DEVICE.
933C
934C     WRITTEN BY--JAMES J. FILLIBEN
935C                 STATISTICAL ENGINEERING DIVISION
936C                 INFORMATION TECHNOLOGY LABORATORY
937C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
938C                 GAITHERSBURG, MD 20899-8980
939C                 PHONE--301-975-2855
940C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
941C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
942C     LANGUAGE--ANSI FORTRAN (1977)
943C     VERSION NUMBER--83.6
944C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
945C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
946C                                      DRIVER OBSOLETE
947C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
948C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
949C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
950C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
951C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
952C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
953C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
954C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
955C                                      DRIVER OBSOLETE
956C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
957C                                      DRIVER OBSOLETE
958C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
959C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
960C                                      USE BILL MITCHELLS OPENGL
961C                                      BINDING FOR FORTRAN
962C     UPDATED         --OCTOBER  1996. GKS (ALAN)
963C                                      CODED, NOT TESTED
964C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
965C                                      PLACEHOLDER FOR NOW
966C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
967C                                      PLACEHOLDER FOR NOW
968C     UPDATED         --OCTOBER  1996. PORTABLE BITMAP (PBM) (ALAN)
969C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
970C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
971C     UPDATED         --JUNE     2000. MACINTOSH
972C                                      PLACEHOLDER FOR NOW
973C     UPDATED         --JUNE     2000. PC PRINTER
974C                                      PLACEHOLDER FOR NOW
975C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
976C     UPDATED         --APRIL    2009. IMPLEMENT LIBPLOT DRIVER
977C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
978C                                      (THESE WERE NEVER ACTUALLY IMPLENENTED)
979C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
980C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
981C
982C
983C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
984C
985#ifdef HAVE_WININTERACTER
986      USE WINTERACTER
987#endif
988#ifdef HAVE_INTERACTER
989      USE INTERACTER
990#endif
991      CHARACTER*130 ICSTR
992      CHARACTER*4 ISUBN0
993      CHARACTER*4 ICARAT
994C
995C-----COMMON----------------------------------------------------------
996C
997      INCLUDE 'DPCOGR.INC'
998      INCLUDE 'DPCONP.INC'
999      INCLUDE 'DPCOBE.INC'
1000      INCLUDE 'DPCOP2.INC'
1001C
1002C-----START POINT-----------------------------------------------------
1003C
1004      ISUBN0='COSC'
1005      IERRG4='NO'
1006C
1007      NCSTR=(-999)
1008      ICHAPS=0
1009      INULLI=0
1010C
1011      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'COSC')THEN
1012        WRITE(ICOUT,999)
1013  999   FORMAT(1X)
1014        CALL DPWRST('XXX','BUG ')
1015        WRITE(ICOUT,51)
1016   51   FORMAT('***** AT THE BEGINNING OF GRCOSC--')
1017        CALL DPWRST('XXX','BUG ')
1018        WRITE(ICOUT,53)IGBAUD,AGCODE
1019   53   FORMAT('IGBAUD,AGCODE = ',I8,G15.7)
1020        CALL DPWRST('XXX','BUG ')
1021        WRITE(ICOUT,54)IMANUF,IMODEL,IBUGG4,ISUBG4
1022   54   FORMAT('IMANUF,IMODEL,IBUGG4,ISUBG4 = ',3(A4,2X),A4)
1023        CALL DPWRST('XXX','BUG ')
1024      ENDIF
1025C
1026C               ********************************************
1027C               **  STEP 1--                              **
1028C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
1029C               **  AND THE MODEL                         **
1030C               ********************************************
1031C
1032      IF(IMANUF.EQ.'QWIN')THEN
1033        GOTO4700
1034      ELSEIF(IMANUF.EQ.'POST')THEN
1035        GOTO8600
1036      ELSEIF(IMANUF.EQ.'X11 ')THEN
1037        GOTO9600
1038      ELSEIF(IMANUF.EQ.'AQUA')THEN
1039        GOTO13500
1040      ELSEIF(IMANUF.EQ.'GENE')THEN
1041        IF(IMODEL.EQ.'CODE')GOTO3200
1042        IF(IMODEL.EQ.'CGM')GOTO3300
1043        IF(IMODEL.EQ.'CGMB')GOTO3400
1044        GOTO3100
1045      ELSEIF(IMANUF.EQ.'SVG ')THEN
1046        GOTO16000
1047      ELSEIF(IMANUF.EQ.'GD  ')THEN
1048        GOTO12000
1049      ELSEIF(IMANUF.EQ.'LATE')THEN
1050        GOTO15000
1051      ELSEIF(IMANUF.EQ.'OPGL')THEN
1052        GOTO4800
1053      ELSEIF(IMANUF.EQ.'CAIR')THEN
1054        GOTO17000
1055      ELSEIF(IMANUF.EQ.'D3  ')THEN
1056        GOTO19000
1057      ELSEIF(IMANUF.EQ.'WMF ')THEN
1058        GOTO18000
1059      ELSEIF(IMANUF.EQ.'TEKT')THEN
1060        IF(IMODEL.EQ.'4662')GOTO9000
1061C
1062        IF(IMODEL.EQ.'4020')GOTO1200
1063        IF(IMODEL.EQ.'4022')GOTO1200
1064        IF(IMODEL.EQ.'4025')GOTO1200
1065        IF(IMODEL.EQ.'4027')GOTO1200
1066C
1067        IF(IMODEL.EQ.'4105')GOTO1300
1068        IF(IMODEL.EQ.'4107')GOTO1300
1069        IF(IMODEL.EQ.'4109')GOTO1300
1070        IF(IMODEL.EQ.'4115')GOTO1300
1071C
1072        GOTO1100
1073C
1074      ELSEIF(IMANUF.EQ.'HP')THEN
1075        IF(IMODEL.EQ.'7221')GOTO2100
1076        IF(IMODEL.EQ.'2622')GOTO2300
1077        IF(IMODEL.EQ.'2623')GOTO2300
1078        IF(IMODEL.EQ.'2627')GOTO2300
1079        IF(IMODEL.EQ.'2647')GOTO2300
1080        GOTO2200
1081      ELSEIF(IMANUF.EQ.'LIBP')THEN
1082        GOTO2600
1083      ELSEIF(IMANUF.EQ.'REGI')THEN
1084        GOTO8100
1085      ELSEIF(IMANUF.EQ.'GKS ')THEN
1086        GOTO11000
1087      ELSEIF(IMANUF.EQ.'LAHE')THEN
1088        IF(IMODEL.EQ.'INTE')GOTO4900
1089        IF(IMODEL.EQ.'WINT')GOTO4950
1090        GOTO4600
1091      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
1092        GOTO13000
1093      ELSEIF(IMANUF.EQ.'QUIC')THEN
1094        GOTO9100
1095      ELSEIF(IMANUF.EQ.'CALC')THEN
1096        GOTO4100
1097      ELSEIF(IMANUF.EQ.'ZETA')THEN
1098        GOTO5100
1099      ELSEIF(IMANUF.EQ.'TURB')THEN
1100        GOTO10000
1101      ELSEIF(IMANUF.EQ.'SUN ')THEN
1102        GOTO6600
1103      ENDIF
1104      GOTO9000
1105C
1106C               ************************************************************
1107C               **  STEP 11--                                             **
1108C               **  TREAT THE TEKTRONIX 400X, 401X, 405X, AND 4114 CASES  **
1109C               **  (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES)      **
1110C               **  TO COPY  THE SCREEN,                                  **
1111C               **  WRITE OUT AN ESCAPE ETB                               **
1112C               ************************************************************
1113C
1114 1100 CONTINUE
1115      ICSTR(1:1)=IESCC
1116      ICSTR(2:2)=IETBC
1117      NCSTR=2
1118      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
1119C
1120      DO1130J=1,10
1121        ICSTR(J:J)=INULC
1122 1130 CONTINUE
1123      NCSTR=10
1124C
1125      INULLI=INT(AGCODE+0.5)
1126      IF(INULLI.GT.0)THEN
1127        DO1135I=1,INULLI
1128          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
1129 1135   CONTINUE
1130      ENDIF
1131C
1132      GOTO9000
1133C
1134C               ******************************************************
1135C               **  STEP 12--                                       **
1136C               **  TREAT THE TEKTRONIX 4020, 4022, AND 4025 CASES  **
1137C               **  (NON-COLOR RASTER DEVICES).                     **
1138C               **  TO COPY  THE SCREEN,                            **
1139C               **  XXX                                             **
1140C               **  REFERENCE--4027 OPERATOR'S MANUAL, PAGE B-5.    **
1141C               ******************************************************
1142C
1143 1200 CONTINUE
1144      ICSTR(1:11)='!COP W/N P;'
1145      NCSTR=11
1146      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
1147      GOTO9000
1148C
1149C               ******************************************************
1150C               **  STEP 13--                                       **
1151C               **  TREAT THE 4105 CASE                             **
1152C               **  (COLOR DEVICE)                                  **
1153C               **  REFERENCE--PAGE 5-53                            **
1154C               ******************************************************
1155C
1156 1300 CONTINUE
1157      ICSTR(1:1)=IESCC
1158      ICSTR(2:2)=IETBC
1159      NCSTR=2
1160      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
1161C
1162      DO1330J=1,10
1163        ICSTR(J:J)=INULC
1164 1330 CONTINUE
1165      NCSTR=10
1166C
1167      INULLI=INT(AGCODE+0.5)
1168      IF(INULLI.GT.0)THEN
1169        DO1335I=1,INULLI
1170          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
1171 1335   CONTINUE
1172      ENDIF
1173C
1174      GOTO9000
1175C
1176C               ******************************************************
1177C               **  STEP 21--                                       **
1178C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
1179C               **  (MULTI-COLOR PENPLOTTER)                        **
1180C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
1181C               **             OPERATING AND PROGRAMMING MANUAL,    **
1182C               **             PAGE XX.                             **
1183C               ******************************************************
1184C
1185 2100 CONTINUE
1186      ICSTR(1:3)='~+}'
1187      NCSTR=3
1188      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
1189      GOTO9000
1190C
1191C               ******************************************************
1192C               **  STEP 22--                                       **
1193C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
1194C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
1195C               **  (MULTI-COLOR PENPLOTTERS)                       **
1196C               **  THERE IS NO    COPY SCREEN   INSTRUCTION PER SE.**
1197C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
1198C               **             OPERATING AND PROGRAMMING MANUAL,    **
1199C               **             PAGE XX, XXX.                        **
1200C               ******************************************************
1201C
1202 2200 CONTINUE
1203      GOTO9000
1204C
1205C               **********************************************************
1206C               **  STEP 23--                                           **
1207C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
1208C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
1209C               **  (MONOCHROME DISPLAY TERMINALS)                      **
1210C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
1211C               **             REFERENCE MANUAL,                        **
1212C               **             PAGE 10-17, 5-5???.                          **
1213C               **********************************************************
1214C
1215 2300 CONTINUE
1216      IF(IMODEL.EQ.'2647')THEN
1217        ICSTR(1:1)=IESCC
1218        ICSTR(2:9)=',cTR A G'
1219        ICSTR(10:10)=ICRC
1220        NCSTR=10
1221        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
1222      ELSE
1223        ICSTR(1:1)=IESCC
1224        ICSTR(2:9)='&p7s4dmZ'
1225        NCSTR=9
1226        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
1227      ENDIF
1228      GOTO9000
1229C
1230C               **********************************************************
1231C               **  STEP 26--                                           **
1232C               **  TREAT THE LIBPLOT LIBRARY.                          **
1233C               **********************************************************
1234C
1235 2600 CONTINUE
1236      GOTO9000
1237C
1238C               ******************************************************
1239C               **  STEP 31--                                       **
1240C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
1241C               ******************************************************
1242C
1243 3100 CONTINUE
1244      ICSTR(1:11)='COPY SCREEN'
1245      NCSTR=11
1246      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
1247      GOTO9000
1248C
1249C               ***************************************************************
1250C               **  STEP 32--                                                **
1251C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
1252C               ***************************************************************
1253C
1254 3200 CONTINUE
1255      ICSTR(1:4)='COSC'
1256      NCSTR=4
1257      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
1258      GOTO9000
1259C
1260C               ***************************************************************
1261C               **  STEP 32--                                                **
1262C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
1263C               **  CGM DOES NOT SUPPORT THIS FEATURE                        **
1264C               ***************************************************************
1265C
1266 3300 CONTINUE
1267      GOTO9000
1268C
1269C               ***************************************************
1270C               **  STEP 34--                                    **
1271C               **  TREAT THE CGM (BINARY)                 CASE  **
1272C               ***************************************************
1273C
1274 3400 CONTINUE
1275      GOTO9000
1276C
1277C               ******************************************************
1278C               **  STEP 41--                                       **
1279C               **  TREAT THE CALCOMP XXXXXX CASE                   **
1280C               **  TO COPY SCREEN--                                **
1281C               **  NO COPY SCREEN FUNCTION                         **
1282C               **  REFERENCE--CALCOMP LIBRARY MANUAL               **
1283C               **             XX                                   **
1284C               **             PAGES XX AND XX                      **
1285C               ******************************************************
1286C
1287 4100 CONTINUE
1288      GOTO9000
1289C
1290C               ******************************************************
1291C               **  STEP 46--                                       **
1292C               **  TREAT THE LAHEY   XXXXXX CASE                   **
1293C               **  NO COPY SCREEN COMMAND SUPPORTED AT THIS TIME   **
1294C               **  REFERENCE--Programmer's Reference, Revision C   **
1295C               **             Lahey Computer Systems, January, 1992**
1296C               **             PAGES 51 THRU 65                     **
1297C               ******************************************************
1298C
1299 4600 CONTINUE
1300      GOTO9000
1301C
1302C               ******************************************************
1303C               **  STEP 47--                                       **
1304C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
1305C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
1306C               ******************************************************
1307C
1308 4700 CONTINUE
1309      GOTO9000
1310C
1311C               ******************************************************
1312C               **  STEP 48--                                       **
1313C               **  TREAT THE OPEN-GL DRIVER                        **
1314C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
1315C               ******************************************************
1316C
1317 4800 CONTINUE
1318      GOTO9000
1319C
1320C               ******************************************************
1321C               **  STEP 49--                                       **
1322C               **  TREAT THE LAHEY INTERACTOR CASE                 **
1323C               ******************************************************
1324C
1325 4900 CONTINUE
1326      GOTO9000
1327C
1328C               ******************************************************
1329C               **  STEP 49B-                                       **
1330C               **  TREAT THE LAHEY WINTERACTOR CASE                **
1331C               ******************************************************
1332C
1333 4950 CONTINUE
1334      GOTO9000
1335C
1336C               ******************************************************
1337C               **  STEP 51--                                       **
1338C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
1339C               **  THERE IS NO    COPY SCREEN   INSTRUCTION PER SE.**
1340C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
1341C               **             MODELS 3600SX AND 3653SX             **
1342C               **             PAGES B-0 AND B-1                    **
1343C               **  USE CALCOMP LIBRARY (NULL ROUTINE)              **
1344C               ******************************************************
1345C
1346 5100 CONTINUE
1347      GOTO9000
1348C
1349C               ******************************************************
1350C               **  STEP 66--                                       **
1351C               **  TREAT THE SUN CASE - NULL ROUTINE               **
1352C               ******************************************************
1353C
1354 6600 CONTINUE
1355      GOTO 9000
1356C
1357C               ******************************************************
1358C               **  STEP 81--                                       **
1359C               **  TREAT THE DEC  REGIS CASE                       **
1360C               **  TO COPY (GRAPHICS) SCREEN---                    **
1361C               **  WRITE OUT AN S ( H )                            **
1362C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
1363C               **             PAGES 146                            **
1364C               ******************************************************
1365C
1366 8100 CONTINUE
1367      ICSTR(1:1)=IESCC
1368      ICSTR(2:3)='Pp'
1369      ICSTR(4:7)='S(H)'
1370      NCSTR=7
1371      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
1372      GOTO9000
1373C
1374C               ******************************************************
1375C               **  STEP 86--                                       **
1376C               **  TREAT THE POSTSCRIPT CASE                       **
1377C               **  NO COPY COMMAND - NULL ROUTINE                  **
1378C               ******************************************************
1379C
1380 8600 CONTINUE
1381      GOTO9000
1382C
1383C               ******************************************************
1384C               **  STEP 91--                                       **
1385C               **  TREAT THE QUIC       CASE                       **
1386C               **  1) ^DCnnnn  - PRINTS nnnn COPIES OF CURRENT PAGE**
1387C               **  2) ^DCCnnnn - PRINTS nnnn COPIES OF ALL         **
1388C               **     SUBSEQUENT PAGES                             **
1389C               **  REFERENCE: QMS PROGRAMMING MANUAL               **
1390C               **  PAGE: 12-6                                      **
1391C               ******************************************************
1392C
1393 9100 CONTINUE
1394      CALL DPCONA(94,ICARAT)
1395      ICSTR(1:1)=ICARAT
1396      ICSTR(2:8)='DC00001'
1397      NCSTR=8
1398      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
1399      GOTO9000
1400C
1401C               ******************************************************
1402C               **  STEP 95--                                       **
1403C               **  TREAT THE X11 CASE - NULL ROUTINE               **
1404C               ******************************************************
1405C
1406 9600 CONTINUE
1407      GOTO9000
1408C
1409C               *************************************************
1410C               **  STEP 100--                                 **
1411C               **  TREAT THE VGA VIA TURBO-C       CASE       **
1412C               *************************************************
1413C
141410000 CONTINUE
1415CTURB CALL TCCOSC
1416      GOTO9000
1417C
1418C               ******************************************************
1419C               **  STEP 110--                                      **
1420C               **  TREAT THE GKS                DRIVER             **
1421C               ******************************************************
1422C
142311000 CONTINUE
1424      GOTO9000
1425C
1426C               ******************************************************
1427C               **  STEP 120--                                      **
1428C               **  TREAT THE GD                     DRIVER         **
1429C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
1430C               **  1) JPEG                                         **
1431C               **  2) PNG                                          **
1432C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
1433C               ******************************************************
1434C
143512000 CONTINUE
1436      GOTO9000
1437C
1438C               ******************************************************
1439C               **  STEP 130--                                      **
1440C               **  TREAT THE ABSOFT                 DRIVER         **
1441C               ******************************************************
1442C
144313000 CONTINUE
1444      GOTO9000
1445C
1446C               ******************************************************
1447C               **  STEP 135--                                      **
1448C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
1449C               ******************************************************
1450C
145113500 CONTINUE
1452      GOTO9000
1453C
1454C               ******************************************************
1455C               **  STEP 150--                                      **
1456C               **  TREAT THE LATEX (EEPIC)                  DRIVER **
1457C               ******************************************************
1458C
145915000 CONTINUE
1460      GOTO9000
1461C
1462C               ******************************************************
1463C               **  STEP 160--                                      **
1464C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
1465C               ******************************************************
1466C
146716000 CONTINUE
1468      GOTO9000
1469C
1470C               ******************************************************
1471C               **  STEP 170--                                      **
1472C               **  TREAT THE CAIRO                          DRIVER **
1473C               ******************************************************
1474C
147517000 CONTINUE
1476      GOTO9000
1477C
1478C               ******************************************************
1479C               **  STEP 180--                                      **
1480C               **  TREAT THE WMF                            DRIVER **
1481C               ******************************************************
1482C
148318000 CONTINUE
1484      GOTO9000
1485C
1486C               ******************************************************
1487C               **  STEP 190--                                      **
1488C               **  TREAT THE D3                             DRIVER **
1489C               ******************************************************
1490C
149119000 CONTINUE
1492      GOTO9000
1493C
1494C               *****************
1495C               **  STEP 90--  **
1496C               **  EXIT       **
1497C               *****************
1498C
1499 9000 CONTINUE
1500      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'COSC')THEN
1501        WRITE(ICOUT,999)
1502        CALL DPWRST('XXX','BUG ')
1503        WRITE(ICOUT,9011)
1504 9011   FORMAT('***** AT THE END       OF GRCOSC--')
1505        CALL DPWRST('XXX','BUG ')
1506        WRITE(ICOUT,9014)ICHAPS,INULLI,NCSTR
1507 9014   FORMAT('ICHAPS,INULLI,NCSTR = ',3I8)
1508        CALL DPWRST('XXX','BUG ')
1509        WRITE(ICOUT,9015)IESCC,IETBC,ISYNC,IERRG4
1510 9015   FORMAT('IESCC,IETBC,ISYNC,IERRG4 = ',3(A1,2X),A1)
1511        CALL DPWRST('XXX','BUG ')
1512        IF(NCSTR.GT.0)THEN
1513          DO9025I=1,NCSTR
1514            CALL DPCOAN(ICSTR(I:I),IASCNE)
1515            WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
1516 9026       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
1517            CALL DPWRST('XXX','BUG ')
1518 9025     CONTINUE
1519        ENDIF
1520      ENDIF
1521C
1522      RETURN
1523      END
1524      SUBROUTINE GRDETH(ICTEXT,NCTEXT,
1525     1                  IFONT,IDIR,ANGLE,
1526     1                  JFONT,JDIR,ANGLE2,
1527     1                  PHEIGH,PWIDTH,PVEGAP,PHOGAP,
1528     1                  JSIZE,JHEIG2,JWIDT2,JVEGA2,JHOGA2,
1529     1                  PHEIG2,PWIDT2,PVEGA2,PHOGA2,
1530     1                  PXLEC,PXLECG,PYLEC,PYLECG)
1531C
1532C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE, FOR THE STANDARD
1533C              (SPECIFIC) FONT, AND FOR THE HORIZONTAL DIRECTION,
1534C              DETERMINE THE LENGTH OF THE TEXT STRING IN THE CHARACTER
1535C              VECTOR ICTEXT(.), WHICH CONSISTS OF NTEXT CHARACTERS.
1536C     NOTE--THE LENGTH IS IN STANDARDIZED COORDINATES
1537C           THAT IS, 0.0 TO 100.0
1538C
1539C     WRITTEN BY--JAMES J. FILLIBEN
1540C                 STATISTICAL ENGINEERING DIVISION
1541C                 INFORMATION TECHNOLOGY LABORATORY
1542C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
1543C                 GAITHERSBURG, MD 20899-8980
1544C                 PHONE--301-975-2855
1545C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
1546C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
1547C     LANGUAGE--ANSI FORTRAN (1977)
1548C     VERSION NUMBER--83.6
1549C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
1550C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
1551C                                      DRIVER OBSOLETE
1552C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
1553C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
1554C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
1555C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
1556C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
1557C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
1558C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
1559C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
1560C                                      DRIVER OBSOLETE
1561C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
1562C                                      OLD CALCOMP STYLE
1563C                                      DRIVER OBSOLETE
1564C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
1565C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
1566C                                      USE BILL MITCHELLS OPENGL
1567C                                      BINDING FOR FORTRAN
1568C     UPDATED         --OCTOBER  1996. GKS (ALAN)
1569C                                      CODED, NOT TESTED
1570C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
1571C                                      PLACEHOLDER FOR NOW
1572C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
1573C                                      PLACEHOLDER FOR NOW
1574C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
1575C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
1576C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
1577C     UPDATED         --JUNE     2000. MACINTOSH
1578C                                      PLACEHOLDER FOR NOW
1579C     UPDATED         --JUNE     2000. PC PRINTER
1580C                                      PLACEHOLDER FOR NOW
1581C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
1582C     UPDATED         --APRIL    2009. IMPLEMENT LIBPLOT DRIVER
1583C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
1584C                                      (THESE WERE NEVER ACTUALLY IMPLENENTED)
1585C
1586C
1587C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
1588C
1589#ifdef HAVE_WININTERACTER
1590      USE WINTERACTER
1591#endif
1592#ifdef HAVE_INTERACTER
1593      USE INTERACTER
1594#endif
1595      CHARACTER*4 ICTEXT
1596      CHARACTER*4 IFONT
1597      CHARACTER*4 IDIR
1598C
1599      DIMENSION ICTEXT(*)
1600C
1601C-----COMMON----------------------------------------------------------
1602C
1603      INCLUDE 'DPCOGR.INC'
1604      INCLUDE 'DPCOBE.INC'
1605      INCLUDE 'DPCODV.INC'
1606      INCLUDE 'DPCOST.INC'
1607      INCLUDE 'DPCOP2.INC'
1608C
1609C-----START POINT-----------------------------------------------------
1610C
1611      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DETH')THEN
1612        WRITE(ICOUT,999)
1613  999   FORMAT(1X)
1614        CALL DPWRST('XXX','BUG ')
1615        WRITE(ICOUT,51)
1616   51   FORMAT('***** AT THE BEGINNING OF GRDETH--')
1617        CALL DPWRST('XXX','BUG ')
1618        WRITE(ICOUT,54)NCTEXT,JFONT,JDIR,JSIZE
1619   54   FORMAT('NCTEXT,JFONT,JDIR,JSIZE = ',4I8)
1620        CALL DPWRST('XXX','BUG ')
1621        WRITE(ICOUT,55)IFONT,IDIR
1622   55   FORMAT('IFONT,IDIR = ',A4,2X,A4)
1623        CALL DPWRST('XXX','BUG ')
1624        WRITE(ICOUT,56)(ICTEXT(I),I=1,MIN(25,NCTEXT))
1625   56   FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
1626        CALL DPWRST('XXX','BUG ')
1627        WRITE(ICOUT,64)ANGLE,ANGLE2
1628   64   FORMAT('ANGLE,ANGLE2= ',E15.7,E15.7)
1629        CALL DPWRST('XXX','BUG ')
1630        WRITE(ICOUT,67)PHEIGH,JHEIG2,PHEIG2
1631   67   FORMAT('PHEIGH,JHEIG2,PHEIG2= ',G15.7,I8,G15.7)
1632        CALL DPWRST('XXX','BUG ')
1633        WRITE(ICOUT,68)PWIDTH,JWIDT2,PWIDT2
1634   68   FORMAT('PWIDTH,JWIDT2,PWIDT2= ',G15.7,I8,G15.7)
1635        CALL DPWRST('XXX','BUG ')
1636        WRITE(ICOUT,69)PVEGAP,JVEGA2,PVEGA2
1637   69   FORMAT('PVEGAP,JVEGA2,PVEGA2= ',G15.7,I8,G15.7)
1638        CALL DPWRST('XXX','BUG ')
1639        WRITE(ICOUT,70)PHOGAP,JHOGA2,PHOGA2
1640   70   FORMAT('PHOGAP,JHOGA2,PHOGA2= ',G15.7,I8,G15.7)
1641        CALL DPWRST('XXX','BUG ')
1642        WRITE(ICOUT,73)PXLEC,PXLECG,PYLEC,PYLECG
1643   73   FORMAT('PXLEC,PXLECG,PYLEC,PYLECG= ',4G15.7)
1644        CALL DPWRST('XXX','BUG ')
1645        WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
1646   79   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',2(A4,2X),A4)
1647        CALL DPWRST('XXX','BUG ')
1648      ENDIF
1649C
1650C                *****************************************************
1651C                **  APRIL, 1988.  GENERIC CASE FOR FIXED SPACE FONT**
1652C                *****************************************************
1653C
1654      ANCTEX=NCTEXT
1655      PXLEC=(ANCTEX-1.0)*(PWIDT2+PHOGA2)+PWIDT2
1656      PXLECG=ANCTEX*(PWIDT2+PHOGA2)
1657      PYLEC=PHEIG2
1658      PYLECG=PHEIG2+PVEGA2
1659C
1660C
1661C               ********************************************
1662C               **  STEP 1--                              **
1663C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
1664C               **  AND THE MODEL                         **
1665C               ********************************************
1666C
1667      IF(IMANUF.EQ.'QWIN')THEN
1668        GOTO4700
1669      ELSEIF(IMANUF.EQ.'POST')THEN
1670        GOTO8600
1671      ELSEIF(IMANUF.EQ.'X11 ')THEN
1672        GOTO9600
1673      ELSEIF(IMANUF.EQ.'AQUA')THEN
1674        GOTO13500
1675      ELSEIF(IMANUF.EQ.'GENE')THEN
1676        IF(IMODEL.EQ.'CODE')GOTO3200
1677        IF(IMODEL.EQ.'CGM')GOTO3300
1678        IF(IMODEL.EQ.'CGMB')GOTO3400
1679        GOTO3100
1680      ELSEIF(IMANUF.EQ.'SVG ')THEN
1681        GOTO16000
1682      ELSEIF(IMANUF.EQ.'GD  ')THEN
1683        GOTO12000
1684      ELSEIF(IMANUF.EQ.'LATE')THEN
1685        GOTO15000
1686      ELSEIF(IMANUF.EQ.'OPGL')THEN
1687        GOTO4800
1688      ELSEIF(IMANUF.EQ.'CAIR')THEN
1689        GOTO17000
1690      ELSEIF(IMANUF.EQ.'D3  ')THEN
1691        GOTO19000
1692      ELSEIF(IMANUF.EQ.'WMF ')THEN
1693        GOTO18000
1694      ELSEIF(IMANUF.EQ.'TEKT')THEN
1695        IF(IMODEL.EQ.'4662')GOTO9000
1696C
1697        IF(IMODEL.EQ.'4020')GOTO1200
1698        IF(IMODEL.EQ.'4022')GOTO1200
1699        IF(IMODEL.EQ.'4025')GOTO1200
1700        IF(IMODEL.EQ.'4027')GOTO1200
1701C
1702        IF(IMODEL.EQ.'4105')GOTO1300
1703        IF(IMODEL.EQ.'4107')GOTO1300
1704        IF(IMODEL.EQ.'4109')GOTO1300
1705        IF(IMODEL.EQ.'4115')GOTO1300
1706C
1707        GOTO1100
1708C
1709      ELSEIF(IMANUF.EQ.'HP')THEN
1710        IF(IMODEL.EQ.'7221')GOTO2100
1711        IF(IMODEL.EQ.'2622')GOTO2300
1712        IF(IMODEL.EQ.'2623')GOTO2300
1713        IF(IMODEL.EQ.'2627')GOTO2300
1714        IF(IMODEL.EQ.'2647')GOTO2300
1715        GOTO2200
1716      ELSEIF(IMANUF.EQ.'LIBP')THEN
1717        GOTO2600
1718      ELSEIF(IMANUF.EQ.'REGI')THEN
1719        GOTO8100
1720      ELSEIF(IMANUF.EQ.'GKS ')THEN
1721        GOTO11000
1722      ELSEIF(IMANUF.EQ.'LAHE')THEN
1723        IF(IMODEL.EQ.'INTE')GOTO4900
1724        IF(IMODEL.EQ.'WINT')GOTO4950
1725        GOTO4600
1726      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
1727        GOTO13000
1728      ELSEIF(IMANUF.EQ.'QUIC')THEN
1729        GOTO9100
1730      ELSEIF(IMANUF.EQ.'CALC')THEN
1731        GOTO4100
1732      ELSEIF(IMANUF.EQ.'ZETA')THEN
1733        GOTO5100
1734      ELSEIF(IMANUF.EQ.'TURB')THEN
1735        GOTO10000
1736      ELSEIF(IMANUF.EQ.'SUN ')THEN
1737        GOTO6600
1738      ENDIF
1739      GOTO9000
1740C
1741C               ******************************************************
1742C               **  STEP 11--                                       **
1743C               **  TREAT THE TEKTRONIX 4662                        **
1744C               **  (A PENPLOTTER).                                 **
1745C               **  REFERENCE--XXX                                  **
1746C               ******************************************************
1747C
1748 1100 CONTINUE
1749      GOTO9000
1750C
1751C               **************************************************************
1752C               **  STEP 12--                                               **
1753C               **  TREAT THE TEKTRONIX 4027 CASE                           **
1754C               **  (COLOR RASTER DEVICES).                                 **
1755C               **  REFERENCE--XXX                                          **
1756C               **************************************************************
1757C
1758 1200 CONTINUE
1759      GOTO9000
1760C
1761C               ******************************************************
1762C               **  STEP 13--                                       **
1763C               **  TREAT THE TEKTRONIX 4105                        **
1764C               **  (COLOR RASTER DEVICE).                          **
1765C               **  REFERENCE--PAGE XXXX (LINE), XXXX (TEXT),       **
1766C               **             XXXX (REGION)                        **
1767C               ******************************************************
1768C
1769 1300 CONTINUE
1770      GOTO9000
1771C               ******************************************************
1772C               **  STEP 21--                                       **
1773C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
1774C               **  (MULTI-COLOR PENPLOTTER)                        **
1775C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
1776C               **             OPERATING AND PROGRAMMING MANUAL,    **
1777C               **             PAGE 73.                             **
1778C               ******************************************************
1779C
1780 2100 CONTINUE
1781      GOTO9000
1782C
1783C               ******************************************************
1784C               **  STEP 22--                                       **
1785C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
1786C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
1787C               **  (MULTI-COLOR PENPLOTTERS)                       **
1788C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
1789C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
1790C               **             OPERATING AND PROGRAMMING MANUAL,    **
1791C               **             PAGE XX, XXX.                        **
1792C               ******************************************************
1793C
1794 2200 CONTINUE
1795      GOTO9000
1796C
1797C               **********************************************************
1798C               **  STEP 23--                                           **
1799C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
1800C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
1801C               **  (MONOCHROME DISPLAY TERMINALS)                      **
1802C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
1803C               **             REFERENCE MANUAL,                        **
1804C               **             PAGE 10-10, XXX.                         **
1805C               **********************************************************
1806C
1807 2300 CONTINUE
1808      GOTO9000
1809C
1810C               ******************************************************
1811C               **  STEP 26--                                       **
1812C               **  TREAT THE LIBPLOT LIBRARY CASE                  **
1813C               ******************************************************
1814C
1815 2600 CONTINUE
1816      GOTO9000
1817C
1818C               ******************************************************
1819C               **  STEP 31--                                       **
1820C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
1821C               ******************************************************
1822C
1823 3100 CONTINUE
1824      GOTO9000
1825C
1826C               ***************************************************************
1827C               **  STEP 32--                                                **
1828C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
1829C               ***************************************************************
1830C
1831 3200 CONTINUE
1832      GOTO9000
1833C
1834C               ******************************************************
1835C               **  STEP 33--                                       **
1836C               **  TREAT THE CGM CASE                              **
1837C               ******************************************************
1838C
1839 3300 CONTINUE
1840      GOTO9000
1841C
1842C               ******************************************************
1843C               **  STEP 33--                                       **
1844C               **  TREAT THE CGM (BINARY) CASE                     **
1845C               ******************************************************
1846C
1847 3400 CONTINUE
1848      GOTO9000
1849C
1850C               ******************************************************
1851C               **  STEP 41--                                       **
1852C               **  TREAT THE CALCOMP XXXXXX CASE                   **
1853C               **  TO SET FILL--                                   **
1854C               **  WRITE OUT AN XXXXXXXXXX                         **
1855C               **  (NOT DONE)                                      **
1856C               **  REFERENCE--XX                                   **
1857C               **             XX                                   **
1858C               **             PAGES XX AND XX                      **
1859C               ******************************************************
1860C
1861 4100 CONTINUE
1862      GOTO9000
1863C
1864C               ******************************************************
1865C               **  STEP 46--                                       **
1866C               **  TREAT THE LAHEY   XXXXXX CASE                   **
1867C               **  REFERENCE--Programmer's Reference, Revision C   **
1868C               **             Lahey Computer Systems, January, 1992**
1869C               **             PAGES 51 THRU 65                     **
1870C               ******************************************************
1871C
1872 4600 CONTINUE
1873      GOTO9000
1874C
1875C               ******************************************************
1876C               **  STEP 47--                                       **
1877C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
1878C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
1879C               ******************************************************
1880C
1881 4700 CONTINUE
1882      GOTO9000
1883C
1884C               ******************************************************
1885C               **  STEP 48--                                       **
1886C               **  TREAT THE OPEN-GL DRIVER                        **
1887C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
1888C               ******************************************************
1889C
1890 4800 CONTINUE
1891      GOTO9000
1892C
1893C               ******************************************************
1894C               **  STEP 49--                                       **
1895C               **  TREAT THE LAHEY INTERACTOR CASE                 **
1896C               ******************************************************
1897C
1898 4900 CONTINUE
1899      GOTO9000
1900C
1901C               ******************************************************
1902C               **  STEP 49B-                                       **
1903C               **  TREAT THE LAHEY WINTERACTOR CASE                **
1904C               ******************************************************
1905C
1906 4950 CONTINUE
1907      GOTO9000
1908C
1909C
1910C               ******************************************************
1911C               **  STEP 51--                                       **
1912C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
1913C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
1914C               **             MODELS 3600SX AND 3653SX             **
1915C               **             PAGES B-0 AND B-1                    **
1916C               ******************************************************
1917C
1918 5100 CONTINUE
1919      GOTO9000
1920C
1921C               ******************************************************
1922C               **  STEP 66--                                       **
1923C               **  TREAT THE SUN CASE                              **
1924C               ******************************************************
1925C
1926 6600 CONTINUE
1927      GOTO9000
1928C
1929C               ******************************************************
1930C               **  STEP 81--                                       **
1931C               **  TREAT THE REGIS CASE                            **
1932C               ******************************************************
1933C
1934 8100 CONTINUE
1935      GOTO9000
1936C
1937C               ******************************************************
1938C               **  STEP 86--                                       **
1939C               **  TREAT THE POSTSCRIPT CASE                       **
1940C               ******************************************************
1941C
1942 8600 CONTINUE
1943      GOTO9000
1944C
1945C               ******************************************************
1946C               **  STEP 91--                                       **
1947C               **  TREAT THE QUIC CASE                             **
1948C               **  SUPPORT THE PROPORTIONAL FONTS THAT ARE         **
1949C               **  "HARD-CODED" IN THE QMS.                        **
1950C               **                                                  **
1951C               ******************************************************
1952C
1953 9100 CONTINUE
1954      ANUMPP=ANUMHP
1955      IFONTT=IQUIFN
1956      IF(IORNSW.EQ.'PORT'.AND.(
1957     1IFONTT.EQ.521.OR.
1958     1IFONTT.EQ.522.OR.
1959     1IFONTT.EQ.523.OR.
1960     1IFONTT.EQ.524))IFONTT=10
1961      IF(IORNSW.NE.'PORT'.AND.(
1962     1IFONTT.EQ.124.OR.
1963     1IFONTT.EQ.144.OR.
1964     1IFONTT.EQ.16.OR.
1965     1IFONTT.EQ.328.OR.
1966     1IFONTT.EQ.998.OR.
1967     1IFONTT.EQ.404.OR.
1968     1IFONTT.EQ.444.OR.
1969     1IFONTT.EQ.532))IFONTT=10
1970      IF(IFONTT.EQ.10)GOTO9000
1971      IF(IFONTT.EQ.404)GOTO9000
1972      IF(IFONTT.EQ.444)GOTO9000
1973      IF(IFONTT.EQ.521)GOTO9000
1974      IF(IFONTT.EQ.522)GOTO9000
1975      IF(IFONTT.EQ.523)GOTO9000
1976      IF(IFONTT.EQ.524)GOTO9000
1977      IF(IFONTT.EQ.532)GOTO9000
1978      IF(IFONTT.EQ.517)GOTO9000
1979      IF(IFONTT.EQ.536)GOTO9000
1980      IF(IFONTT.EQ.904)GOTO9000
1981      IF(IFONTT.EQ.924)GOTO9000
1982      IF(IFONTT.EQ.104)CALL QUICH1(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
1983      IF(IFONTT.EQ.124)CALL QUICH2(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
1984      IF(IFONTT.EQ.144)CALL QUICH3(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
1985      IF(IFONTT.EQ.16) CALL QUICH4(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
1986      IF(IFONTT.EQ.204)CALL QUICH5(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
1987      IF(IFONTT.EQ.328)CALL QUICH6(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
1988      IF(IFONTT.EQ.998)CALL QUICH7(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
1989      IF(IFONTT.EQ.664)CALL QUICH8(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
1990      GOTO9000
1991C
1992C               ******************************************************
1993C               **  STEP 96--                                       **
1994C               **  TREAT THE X11     CASE                          **
1995C               ******************************************************
1996C
1997 9600 CONTINUE
1998      GOTO9000
1999C
2000C               *************************************************
2001C               **  STEP 100--                                 **
2002C               **  TREAT THE VGA VIA TURBO-C       CASE       **
2003C               *************************************************
2004C
200510000 CONTINUE
2006      GOTO9000
2007C
2008C               ******************************************************
2009C               **  STEP 110--                                      **
2010C               **  TREAT THE GKS                DRIVER             **
2011C               ******************************************************
2012C
201311000 CONTINUE
2014      GOTO9000
2015C
2016C               ******************************************************
2017C               **  STEP 120--                                      **
2018C               **  TREAT THE GD                     DRIVER         **
2019C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
2020C               **  1) JPEG                                         **
2021C               **  2) PNG                                          **
2022C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
2023C               ******************************************************
2024C
202512000 CONTINUE
2026      GOTO9000
2027C
2028C               ******************************************************
2029C               **  STEP 130--                                      **
2030C               **  TREAT THE ABSOFT                 DRIVER         **
2031C               ******************************************************
2032C
203313000 CONTINUE
2034      GOTO9000
2035C
2036C               ******************************************************
2037C               **  STEP 135--                                      **
2038C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
2039C               ******************************************************
2040C
204113500 CONTINUE
2042      GOTO9000
2043C
2044C               ******************************************************
2045C               **  STEP 150--                                      **
2046C               **  TREAT THE LATEX (EEPIC)                  DRIVER **
2047C               ******************************************************
2048C
204915000 CONTINUE
2050      GOTO9000
2051C
2052C               ******************************************************
2053C               **  STEP 160--                                      **
2054C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
2055C               ******************************************************
2056C
205716000 CONTINUE
2058      GOTO9000
2059C
2060C               ******************************************************
2061C               **  STEP 170--                                      **
2062C               **  TREAT THE CAIRO                          DRIVER **
2063C               ******************************************************
2064C
206517000 CONTINUE
2066      GOTO9000
2067C
2068C               ******************************************************
2069C               **  STEP 180--                                      **
2070C               **  TREAT THE WMF                            DRIVER **
2071C               ******************************************************
2072C
207318000 CONTINUE
2074      GOTO9000
2075C
2076C               ******************************************************
2077C               **  STEP 190--                                      **
2078C               **  TREAT THE D3                             DRIVER **
2079C               ******************************************************
2080C
208119000 CONTINUE
2082      GOTO9000
2083C
2084C               *****************
2085C               **  STEP 90--  **
2086C               **  EXIT       **
2087C               *****************
2088C
2089 9000 CONTINUE
2090      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DETH')THEN
2091        WRITE(ICOUT,999)
2092        CALL DPWRST('XXX','BUG ')
2093        WRITE(ICOUT,9011)
2094 9011   FORMAT('***** AT THE END       OF GRDETH--')
2095        CALL DPWRST('XXX','BUG ')
2096        WRITE(ICOUT,9039)IERRG4
2097 9039   FORMAT('IERRG4 = ',A4)
2098        CALL DPWRST('XXX','BUG ')
2099      ENDIF
2100C
2101      RETURN
2102      END
2103      SUBROUTINE GRDETV(ICTEXT,NCTEXT,
2104     1                  IFONT,IDIR,ANGLE,
2105     1                  JFONT,JDIR,ANGLE2,
2106     1                  PHEIGH,PWIDTH,PVEGAP,PHOGAP,
2107     1                  JSIZE,
2108     1                  JHEIG2,JWIDT2,JVEGA2,JHOGA2,
2109     1                  PHEIG2,PWIDT2,PVEGA2,PHOGA2,
2110     1                  PXLEC,PXLECG,PYLEC,PYLECG)
2111C
2112C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE, FOR THE STANDARD
2113C              (TEKTRONIX) FONT, AND FOR THE VERTICAL DIRECTION,
2114C              DETERMINE THE LENGTH OF THE TEXT STRING IN THE CHARACTER
2115C              VECTOR ICTEXT(.), WHICH CONSISTS OF NTEXT CHARACTERS.
2116C     NOTE--THE LENGTH IS IN STANDARDIZED COORDINATES
2117C           THAT IS, 0.0 TO 100.0
2118C
2119C     WRITTEN BY--JAMES J. FILLIBEN
2120C                 STATISTICAL ENGINEERING DIVISION
2121C                 INFORMATION TECHNOLOGY LABORATORY
2122C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
2123C                 GAITHERSBURG, MD 20899-8980
2124C                 PHONE--301-975-2855
2125C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
2126C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
2127C     LANGUAGE--ANSI FORTRAN (1977)
2128C     VERSION NUMBER--83.6
2129C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
2130C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
2131C                                      DRIVER OBSOLETE
2132C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
2133C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
2134C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
2135C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
2136C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
2137C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
2138C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
2139C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
2140C                                      DRIVER OBSOLETE
2141C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
2142C                                      DRIVER OBSOLETE
2143C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
2144C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
2145C                                      USE BILL MITCHELLS OPENGL
2146C                                      BINDING FOR FORTRAN
2147C     UPDATED         --OCTOBER  1996. GKS (ALAN)
2148C                                      CODED, NOT TESTED
2149C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
2150C                                      PLACEHOLDER FOR NOW
2151C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
2152C                                      PLACEHOLDER FOR NOW
2153C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
2154C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
2155C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
2156C     UPDATED         --JUNE     2000. MACINTOSH
2157C                                      PLACEHOLDER FOR NOW
2158C     UPDATED         --JUNE     2000. PC PRINTER
2159C                                      PLACEHOLDER FOR NOW
2160C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
2161C     UPDATED         --APRIL    2009. IMPLEMENT LIBPLOT DRIVER
2162C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
2163C                                      (THESE WERE NEVER ACTUALLY IMPLENENTED)
2164C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
2165C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
2166C
2167C
2168C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
2169C
2170#ifdef HAVE_WININTERACTER
2171      USE WINTERACTER
2172#endif
2173#ifdef HAVE_INTERACTER
2174      USE INTERACTER
2175#endif
2176      CHARACTER*4 ICTEXT
2177      CHARACTER*4 IFONT
2178      CHARACTER*4 IDIR
2179C
2180      DIMENSION ICTEXT(*)
2181C
2182C-----COMMON----------------------------------------------------------
2183C
2184      INCLUDE 'DPCOGR.INC'
2185      INCLUDE 'DPCOBE.INC'
2186      INCLUDE 'DPCODV.INC'
2187      INCLUDE 'DPCOST.INC'
2188      INCLUDE 'DPCOP2.INC'
2189C
2190C-----START POINT-----------------------------------------------------
2191C
2192      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DETV')THEN
2193        WRITE(ICOUT,999)
2194  999   FORMAT(1X)
2195        CALL DPWRST('XXX','BUG ')
2196        WRITE(ICOUT,51)
2197   51   FORMAT('***** AT THE BEGINNING OF GRDETV--')
2198        CALL DPWRST('XXX','BUG ')
2199        WRITE(ICOUT,54)NCTEXT,JFONT,JDIR,JSIZE
2200   54   FORMAT('NCTEXT,JFONT,JDIR,JSIZE = ',4I8)
2201        CALL DPWRST('XXX','BUG ')
2202        WRITE(ICOUT,55)(ICTEXT(I),I=1,MIN(25,NCTEXT))
2203   55   FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
2204        CALL DPWRST('XXX','BUG ')
2205        WRITE(ICOUT,61)IFONT,IDIR,ANGLE,ANGLE2
2206   61   FORMAT('IFONT,IDIR,ANGLE,ANGLE2 = ',2(A4,2X),2G15.7)
2207        CALL DPWRST('XXX','BUG ')
2208        WRITE(ICOUT,67)PHEIGH,JHEIG2,PHEIG2
2209   67   FORMAT('PHEIGH,JHEIG2,PHEIG2= ',G15.7,I8,G15.7)
2210        CALL DPWRST('XXX','BUG ')
2211        WRITE(ICOUT,68)PWIDTH,JWIDT2,PWIDT2
2212   68   FORMAT('PWIDTH,JWIDT2,PWIDT2= ',G15.7,I8,G15.7)
2213        CALL DPWRST('XXX','BUG ')
2214        WRITE(ICOUT,69)PVEGAP,JVEGA2,PVEGA2
2215   69   FORMAT('PVEGAP,JVEGA2,PVEGA2= ',G15.7,I8,G15.7)
2216        CALL DPWRST('XXX','BUG ')
2217        WRITE(ICOUT,70)PHOGAP,JHOGA2,PHOGA2
2218   70   FORMAT('PHOGAP,JHOGA2,PHOGA2= ',G15.7,I8,G15.7)
2219        CALL DPWRST('XXX','BUG ')
2220        WRITE(ICOUT,73)PXLEC,PXLECG,PYLEC,PYLECG
2221   73   FORMAT('PXLEC,PXLECG,PYLEC,PYLECG = '4G15.7)
2222        CALL DPWRST('XXX','BUG ')
2223        WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
2224   79   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',2(A4,2X),A4)
2225        CALL DPWRST('XXX','BUG ')
2226      ENDIF
2227C
2228C                *****************************************************
2229C                **  APRIL, 1988.  GENERIC CASE FOR FIXED SPACE FONT**
2230C                *****************************************************
2231C
2232      ANCTEX=NCTEXT
2233      PXLEC=PWIDT2
2234      PXLECG=PWIDT2+PHOGA2
2235      PYLEC=(ANCTEX-1.0)*(PHEIG2+PVEGA2)+PHEIG2
2236      PYLECG=ANCTEX*(PHEIG2+PVEGA2)
2237C
2238C
2239C
2240C               ********************************************
2241C               **  STEP 1--                              **
2242C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
2243C               **  AND THE MODEL                         **
2244C               ********************************************
2245C
2246      IF(IMANUF.EQ.'QWIN')THEN
2247        GOTO4700
2248      ELSEIF(IMANUF.EQ.'POST')THEN
2249        GOTO8600
2250      ELSEIF(IMANUF.EQ.'X11 ')THEN
2251        GOTO9600
2252      ELSEIF(IMANUF.EQ.'AQUA')THEN
2253        GOTO13500
2254      ELSEIF(IMANUF.EQ.'GENE')THEN
2255        IF(IMODEL.EQ.'CODE')GOTO3200
2256        IF(IMODEL.EQ.'CGM')GOTO3300
2257        IF(IMODEL.EQ.'CGMB')GOTO3400
2258        GOTO3100
2259      ELSEIF(IMANUF.EQ.'SVG ')THEN
2260        GOTO16000
2261      ELSEIF(IMANUF.EQ.'GD  ')THEN
2262        GOTO12000
2263      ELSEIF(IMANUF.EQ.'LATE')THEN
2264        GOTO15000
2265      ELSEIF(IMANUF.EQ.'CAIR')THEN
2266        GOTO17000
2267      ELSEIF(IMANUF.EQ.'D3  ')THEN
2268        GOTO19000
2269      ELSEIF(IMANUF.EQ.'WMF ')THEN
2270        GOTO18000
2271      ELSEIF(IMANUF.EQ.'OPGL')THEN
2272        GOTO4800
2273      ELSEIF(IMANUF.EQ.'TEKT')THEN
2274        IF(IMODEL.EQ.'4662')GOTO1100
2275        IF(IMODEL.EQ.'4027')GOTO1200
2276        IF(IMODEL.EQ.'4105')GOTO1300
2277        IF(IMODEL.EQ.'4107')GOTO1300
2278        IF(IMODEL.EQ.'4109')GOTO1300
2279        IF(IMODEL.EQ.'4115')GOTO1300
2280        IF(IMODEL.EQ.'4107')GOTO1300
2281        IF(IMODEL.EQ.'4113')GOTO1300
2282        GOTO9000
2283      ELSEIF(IMANUF.EQ.'HP')THEN
2284        IF(IMODEL.EQ.'7221')GOTO2100
2285        IF(IMODEL.EQ.'2622')GOTO2300
2286        IF(IMODEL.EQ.'2623')GOTO2300
2287        IF(IMODEL.EQ.'2627')GOTO2300
2288        IF(IMODEL.EQ.'2647')GOTO2300
2289        GOTO2200
2290      ELSEIF(IMANUF.EQ.'LIBP')THEN
2291        GOTO2600
2292      ELSEIF(IMANUF.EQ.'REGI')THEN
2293        GOTO8100
2294      ELSEIF(IMANUF.EQ.'GKS ')THEN
2295        GOTO11000
2296      ELSEIF(IMANUF.EQ.'LAHE')THEN
2297        IF(IMODEL.EQ.'INTE')GOTO4900
2298        IF(IMODEL.EQ.'WINT')GOTO4950
2299        GOTO4600
2300      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
2301        GOTO13000
2302      ELSEIF(IMANUF.EQ.'QUIC')THEN
2303        GOTO9100
2304      ELSEIF(IMANUF.EQ.'CALC')THEN
2305        GOTO4100
2306      ELSEIF(IMANUF.EQ.'ZETA')THEN
2307        GOTO5100
2308      ELSEIF(IMANUF.EQ.'TURB')THEN
2309        GOTO10000
2310      ELSEIF(IMANUF.EQ.'SUN ')THEN
2311        GOTO6600
2312      ENDIF
2313      GOTO9000
2314C
2315C               ******************************************************
2316C               **  STEP 11--                                       **
2317C               **  TREAT THE TEKTRONIX 4662                        **
2318C               **  (A PENPLOTTER).                                 **
2319C               **  REFERENCE--XXX                                  **
2320C               ******************************************************
2321C
2322 1100 CONTINUE
2323      GOTO9000
2324C
2325C               **************************************************************
2326C               **  STEP 12--                                               **
2327C               **  TREAT THE TEKTRONIX 4027 CASE                           **
2328C               **  (COLOR RASTER DEVICES).                                 **
2329C               **  REFERENCE--XXX                                          **
2330C               **************************************************************
2331C
2332 1200 CONTINUE
2333      GOTO9000
2334C
2335C               ******************************************************
2336C               **  STEP 13--                                       **
2337C               **  TREAT THE TEKTRONIX 4105                        **
2338C               **  (COLOR RASTER DEVICE).                          **
2339C               **  REFERENCE--PAGE XXXX (LINE), XXXX (TEXT),       **
2340C               **             XXXX (REGION)                        **
2341C               ******************************************************
2342C
2343 1300 CONTINUE
2344      GOTO9000
2345C               ******************************************************
2346C               **  STEP 21--                                       **
2347C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
2348C               **  (MULTI-COLOR PENPLOTTER)                        **
2349C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
2350C               **             OPERATING AND PROGRAMMING MANUAL,    **
2351C               **             PAGE 73.                             **
2352C               ******************************************************
2353C
2354 2100 CONTINUE
2355      GOTO9000
2356C
2357C               ******************************************************
2358C               **  STEP 22--                                       **
2359C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
2360C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
2361C               **  (MULTI-COLOR PENPLOTTERS)                       **
2362C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
2363C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
2364C               **             OPERATING AND PROGRAMMING MANUAL,    **
2365C               **             PAGE XX, XXX.                        **
2366C               ******************************************************
2367C
2368 2200 CONTINUE
2369      GOTO9000
2370C
2371C               **********************************************************
2372C               **  STEP 23--                                           **
2373C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
2374C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
2375C               **  (MONOCHROME DISPLAY TERMINALS)                      **
2376C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
2377C               **             REFERENCE MANUAL,                        **
2378C               **             PAGE 10-10, XXX.                         **
2379C               **********************************************************
2380C
2381 2300 CONTINUE
2382      GOTO9000
2383C
2384C               ******************************************************
2385C               **  STEP 26--                                       **
2386C               **  TREAT THE LIBPLOT LIBRARY CASE                  **
2387C               ******************************************************
2388C
2389 2600 CONTINUE
2390      GOTO9000
2391C
2392C               ******************************************************
2393C               **  STEP 31--                                       **
2394C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
2395C               ******************************************************
2396C
2397 3100 CONTINUE
2398      GOTO9000
2399C
2400C               ***************************************************************
2401C               **  STEP 32--                                                **
2402C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
2403C               ***************************************************************
2404C
2405 3200 CONTINUE
2406      GOTO9000
2407C
2408C               ******************************************************
2409C               **  STEP 33--                                       **
2410C               **  TREAT THE CGM CASE                              **
2411C               ******************************************************
2412C
2413 3300 CONTINUE
2414      GOTO9000
2415C
2416C               ***************************************************
2417C               **  STEP 34--                                    **
2418C               **  TREAT THE CGM (BINARY)                 CASE  **
2419C               ***************************************************
2420C
2421 3400 CONTINUE
2422      GOTO9000
2423C
2424C               ******************************************************
2425C               **  STEP 41--                                       **
2426C               **  TREAT THE CALCOMP XXXXXX CASE                   **
2427C               **  VERTICAL TEXT STRINGS WILL BE ROTATED           **
2428C               **  REFERENCE--USE CALCOMP LIBRARY ROUTINES         **
2429C               **             XX                                   **
2430C               **             PAGES XX AND XX                      **
2431C               ******************************************************
2432C
2433 4100 CONTINUE
2434      ANCTEX=NCTEXT
2435      PYLEC=PHEIG2
2436      PYLECG=PHEIG2+PVEGA2
2437      PXLEC=(ANCTEX-1.0)*(PWIDT2+PHOGA2)+PWIDT2
2438      PXLECG=ANCTEX*(PWIDT2+PHOGA2)
2439      GOTO9000
2440C
2441C               ******************************************************
2442C               **  STEP 46--                                       **
2443C               **  TREAT THE LAHEY   XXXXXX CASE                   **
2444C               **  REFERENCE--Programmer's Reference, Revision C   **
2445C               **             Lahey Computer Systems, January, 1992**
2446C               **             PAGES 51 THRU 65                     **
2447C               ******************************************************
2448C
2449 4600 CONTINUE
2450      GOTO9000
2451C
2452C               ******************************************************
2453C               **  STEP 47--                                       **
2454C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
2455C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
2456C               ******************************************************
2457C
2458 4700 CONTINUE
2459      GOTO9000
2460C
2461C               ******************************************************
2462C               **  STEP 48--                                       **
2463C               **  TREAT THE OPEN-GL DRIVER                        **
2464C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
2465C               ******************************************************
2466C
2467 4800 CONTINUE
2468      GOTO9000
2469C
2470C               ******************************************************
2471C               **  STEP 49--                                       **
2472C               **  TREAT THE LAHEY INTERACTOR CASE                 **
2473C               ******************************************************
2474C
2475 4900 CONTINUE
2476      GOTO9000
2477C
2478C               ******************************************************
2479C               **  STEP 49B-                                       **
2480C               **  TREAT THE LAHEY WINTERACTOR CASE                **
2481C               ******************************************************
2482C
2483 4950 CONTINUE
2484      GOTO9000
2485C
2486C
2487C               ******************************************************
2488C               **  STEP 51--                                       **
2489C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
2490C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
2491C               **             MODELS 3600SX AND 3653SX             **
2492C               **             PAGES B-0 AND B-1                    **
2493C               ******************************************************
2494C
2495 5100 CONTINUE
2496      ANCTEX=NCTEXT
2497      PYLEC=PHEIG2
2498      PYLECG=PHEIG2+PVEGA2
2499      PXLEC=(ANCTEX-1.0)*(PWIDT2+PHOGA2)+PWIDT2
2500      PXLECG=ANCTEX*(PWIDT2+PHOGA2)
2501      GOTO9000
2502C
2503C               ******************************************************
2504C               **  STEP 66--                                       **
2505C               **  TREAT THE SUN CASE                              **
2506C               ******************************************************
2507C
2508 6600 CONTINUE
2509      GOTO9000
2510C
2511C               ******************************************************
2512C               **  STEP 81--                                       **
2513C               **  TREAT THE REGIS CASE                            **
2514C               ******************************************************
2515C
2516 8100 CONTINUE
2517      GOTO9000
2518C
2519C               ******************************************************
2520C               **  STEP 86--                                       **
2521C               **  TREAT THE POSTSCRIPT CASE                       **
2522C               ******************************************************
2523C
2524 8600 CONTINUE
2525      ANCTEX=NCTEXT
2526      PYLEC=PHEIG2
2527      PYLECG=PHEIG2+PVEGA2
2528      PXLEC=(ANCTEX-1.0)*(PWIDT2+PHOGA2)+PWIDT2
2529      PXLECG=ANCTEX*(PWIDT2+PHOGA2)
2530      GOTO9000
2531C
2532C               ******************************************************
2533C               **  STEP 91--                                       **
2534C               **  TREAT THE QUIC CASE                             **
2535C               **  SUPPORT THE PROPORTIONAL FONTS THAT ARE         **
2536C               **  "HARD-CODED" IN THE QMS.                        **
2537C               **                                                  **
2538C               ******************************************************
2539C
2540 9100 CONTINUE
2541      GOTO9000
2542C
2543C               ******************************************************
2544C               **  STEP 96--                                       **
2545C               **  TREAT THE X11     CASE                          **
2546C               ******************************************************
2547C
2548 9600 CONTINUE
2549      GOTO9000
2550C
2551C               *************************************************
2552C               **  STEP 100--                                 **
2553C               **  TREAT THE VGA VIA TURBO-C       CASE       **
2554C               *************************************************
2555C
255610000 CONTINUE
2557      GOTO9000
2558C
2559C               ******************************************************
2560C               **  STEP 110--                                      **
2561C               **  TREAT THE GKS                DRIVER             **
2562C               ******************************************************
2563C
256411000 CONTINUE
2565      GOTO9000
2566C
2567C               ******************************************************
2568C               **  STEP 120--                                      **
2569C               **  TREAT THE GD                     DRIVER         **
2570C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
2571C               **  1) JPEG                                         **
2572C               **  2) PNG                                          **
2573C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
2574C               ******************************************************
2575C
257612000 CONTINUE
2577      GOTO9000
2578C
2579C               ******************************************************
2580C               **  STEP 130--                                      **
2581C               **  TREAT THE ABSOFT                 DRIVER         **
2582C               ******************************************************
2583C
258413000 CONTINUE
2585      GOTO9000
2586C
2587C               ******************************************************
2588C               **  STEP 135--                                      **
2589C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
2590C               ******************************************************
2591C
259213500 CONTINUE
2593      GOTO9000
2594C
2595C               ******************************************************
2596C               **  STEP 150--                                      **
2597C               **  TREAT THE LATEX (EEPIC)                  DRIVER **
2598C               ******************************************************
2599C
260015000 CONTINUE
2601      GOTO9000
2602C
2603C               ******************************************************
2604C               **  STEP 160--                                      **
2605C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
2606C               ******************************************************
2607C
260816000 CONTINUE
2609      GOTO9000
2610C
2611C               ******************************************************
2612C               **  STEP 170--                                      **
2613C               **  TREAT THE CAIRO                          DRIVER **
2614C               ******************************************************
2615C
261617000 CONTINUE
2617      GOTO9000
2618C
2619C               ******************************************************
2620C               **  STEP 180--                                      **
2621C               **  TREAT THE WMF                            DRIVER **
2622C               ******************************************************
2623C
262418000 CONTINUE
2625      GOTO9000
2626C
2627C               ******************************************************
2628C               **  STEP 190--                                      **
2629C               **  TREAT THE D3                             DRIVER **
2630C               ******************************************************
2631C
263219000 CONTINUE
2633      GOTO9000
2634C
2635C               *****************
2636C               **  STEP 90--  **
2637C               **  EXIT       **
2638C               *****************
2639C
2640 9000 CONTINUE
2641      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DETV')THEN
2642        WRITE(ICOUT,999)
2643        CALL DPWRST('XXX','BUG ')
2644        WRITE(ICOUT,9011)
2645 9011   FORMAT('***** AT THE END       OF GRDETV--')
2646        CALL DPWRST('XXX','BUG ')
2647        WRITE(ICOUT,9039)IERRG4
2648 9039   FORMAT('IERRG4 = ',A4)
2649        CALL DPWRST('XXX','BUG ')
2650      ENDIF
2651C
2652      RETURN
2653      END
2654      SUBROUTINE GRDRIM(PX,PY,NP,
2655     1                  ICASCO,IJUST,PHEIGH,
2656     1                  YRED,YBLUE,YGREEN,YALPHA,
2657     1                  PXMIN,PYMIN,PXMAX,PYMAX)
2658C
2659C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE, DRAW AN IMAGE.  THE PX
2660C              AND PY ARRAYS CONTAIN THE ROW-ID AND COLUMN-ID VECTORS,
2661C              RESPECTIVELY.  THE YRED, YBLUE AND YGREEN ARRAYS CONTAIN
2662C              THE RED/BLUE/GREEN COMPONENTS (ON A 0 TO 1 SCALE).  THE
2663C              YALPHA ARRAY IS RESERVED FOR FUTURE USE.
2664C     NOTE--THE COORDINATES IN (PX(.),PY(.)) ARE IN
2665C           STANDARDIZED (0.0 TO 100.0) UNITS.
2666C     NOTE--THERE ARE NP SUCH COORDINATE PAIRS.
2667C
2668C     WRITTEN BY--JAMES J. FILLIBEN
2669C                 STATISTICAL ENGINEERING DIVISION
2670C                 INFORMATION TECHNOLOGY LABORATORY
2671C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
2672C                 GAITHERSBURG, MD 20899-8980
2673C                 PHONE--301-975-2899
2674C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
2675C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
2676C     LANGUAGE--ANSI FORTRAN (1977)
2677C     VERSION NUMBER--2008.3
2678C     ORIGINAL VERSION--MARCH    2008.
2679C     UPDATED         --APRIL    2009. IMPLEMENT LIBPLOT DRIVER
2680C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
2681C                                      (THESE WERE NEVER ACTUALLY IMPLENENTED)
2682C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
2683C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
2684C
2685C
2686C-----NON-COMMON VARIABLES (GRAPHICS)---------------------------------
2687C
2688#ifdef HAVE_WININTERACTER
2689      USE WINTERACTER
2690#endif
2691#ifdef HAVE_INTERACTER
2692      USE INTERACTER
2693#endif
2694CCCCC FOLLOWING LINE FOR MICROSOFT FORTRAN OCTOBER 1996
2695CQWIN USE DFLIB
2696#ifdef HAVE_QWIN
2697      USE IFQWIN
2698CCCCC LOGICAL MODESTATUS
2699      TYPE (WINDOWCONFIG)   DPSCREEN
2700      CHARACTER*4 QWSCRN
2701      COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWFN
2702CCCCC TYPE (XYCOORD)   WXY
2703#endif
2704C
2705      CHARACTER*4 ICASCO
2706      CHARACTER*4 IJUST
2707      CHARACTER*1 IQUOTE
2708      CHARACTER*2 ICJUNK
2709C
2710      DIMENSION PX(*)
2711      DIMENSION PY(*)
2712      DIMENSION YRED(*)
2713      DIMENSION YBLUE(*)
2714      DIMENSION YGREEN(*)
2715      DIMENSION YALPHA(*)
2716C
2717      CHARACTER*130 ICSTR
2718      CHARACTER*4 ISUBN0
2719CCCCC FOLLOWING 5 LINES FOR LAHEY COMPILER ADDED JULY 1996.
2720#ifdef HAVE_LAHEY_CALCOMP
2721      CHARACTER*40 CLAHEY
2722      REAL RLAHEY(7)
2723      INTEGER ILAHEY(9)
2724#endif
2725      CHARACTER*4 IERROR
2726      CHARACTER*4 IWRITE
2727C
2728C-----COMMON----------------------------------------------------------
2729C
2730      INCLUDE 'DPCOPA.INC'
2731      INCLUDE 'DPCOGR.INC'
2732      INCLUDE 'DPCONP.INC'
2733      INCLUDE 'DPCOBE.INC'
2734      INCLUDE 'DPCOST.INC'
2735      INCLUDE 'DPCODV.INC'
2736      INCLUDE 'DPCOF2.INC'
2737C
2738      COMMON /RWIND/
2739     1PWXMIN,PWXMAX,PWYMIN,PWYMAX,PWZMIN,PWZMAX,
2740     1WWXMIN,WWXMAX,WWYMIN,WWYMAX,WWZMIN,WWZMAX
2741C
2742C-----COMMON VARIABLES (GENERAL)--------------------------------------
2743C
2744      INCLUDE 'DPCOP2.INC'
2745C
2746C-----START POINT-----------------------------------------------------
2747C
2748      ISUBN0='DRIM'
2749      IERRG4='NO'
2750C
2751      NCSTR=(-999)
2752      IXINC=0
2753      IYINC=0
2754C
2755      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRIM')THEN
2756        WRITE(ICOUT,999)
2757  999   FORMAT(1X)
2758        CALL DPWRST('XXX','BUG ')
2759        WRITE(ICOUT,51)
2760   51   FORMAT('***** AT THE BEGINNING OF GRDRIM--')
2761        CALL DPWRST('XXX','BUG ')
2762        WRITE(ICOUT,52)NP,IMANUF,IGUNIT
2763   52   FORMAT('NP,IMANUF,IGUNIT = ',3I8)
2764        CALL DPWRST('XXX','BUG ')
2765        DO55I=1,NP
2766          WRITE(ICOUT,56)I,PX(I),PY(I),YRED(I),YBLUE(I),YGREEN(I),
2767     1                   YALPHA(I)
2768   56     FORMAT('I,PX(I),PY(I)YRED(I),YBLUE(I),YGREEN(I),',
2769     1           'YALPHA(I) = ',I8,6F10.5)
2770          CALL DPWRST('XXX','BUG ')
2771   55   CONTINUE
2772        WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
2773   79   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
2774        CALL DPWRST('XXX','BUG ')
2775      ENDIF
2776C
2777C               ********************************************
2778C               **  STEP 1--                              **
2779C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
2780C               **  AND THE MODEL                         **
2781C               ********************************************
2782C
2783      CALL MAXIM(PX,NP,IWRITE,XMAX,IBUGG4,IERROR)
2784      NROWS=INT(XMAX+0.1)
2785      CALL MAXIM(PY,NP,IWRITE,XMAX,IBUGG4,IERROR)
2786      NCOLS=INT(XMAX+0.1)
2787C
2788      IFONTH=0
2789      IFONTV=0
2790      IF(IJUST.EQ.'LEFT')IFONTH=0
2791      IF(IJUST.EQ.'CENT')IFONTH=1
2792      IF(IJUST.EQ.'RIGH')IFONTH=2
2793      IF(IJUST.EQ.'LJUS')IFONTH=0
2794      IF(IJUST.EQ.'CJUS')IFONTH=1
2795      IF(IJUST.EQ.'RJUS')IFONTH=2
2796      IF(IJUST.EQ.'LEBO')IFONTH=0
2797      IF(IJUST.EQ.'CEBO')IFONTH=1
2798      IF(IJUST.EQ.'RIBO')IFONTH=2
2799      IF(IJUST.EQ.'LECE')IFONTH=0
2800      IF(IJUST.EQ.'CECE')IFONTH=1
2801      IF(IJUST.EQ.'RICE')IFONTH=2
2802      IF(IJUST.EQ.'LETO')IFONTH=0
2803      IF(IJUST.EQ.'CETO')IFONTH=1
2804      IF(IJUST.EQ.'RITO')IFONTH=2
2805      IF(IJUST.EQ.'LEFT')IFONTV=1
2806      IF(IJUST.EQ.'CENT')IFONTV=1
2807      IF(IJUST.EQ.'RIGH')IFONTV=1
2808      IF(IJUST.EQ.'LJUS')IFONTV=1
2809      IF(IJUST.EQ.'CJUS')IFONTV=1
2810      IF(IJUST.EQ.'RJUS')IFONTV=1
2811      IF(IJUST.EQ.'LEBO')IFONTV=1
2812      IF(IJUST.EQ.'CEBO')IFONTV=1
2813      IF(IJUST.EQ.'RIBO')IFONTV=1
2814      IF(IJUST.EQ.'LECE')IFONTV=0
2815      IF(IJUST.EQ.'CECE')IFONTV=0
2816      IF(IJUST.EQ.'RICE')IFONTV=0
2817      IF(IJUST.EQ.'LETO')IFONTV=2
2818      IF(IJUST.EQ.'CETO')IFONTV=2
2819      IF(IJUST.EQ.'RITO')IFONTV=2
2820      IF(IMANUF.EQ.'QWIN')THEN
2821        GOTO4700
2822      ELSEIF(IMANUF.EQ.'POST')THEN
2823        GOTO8600
2824      ELSEIF(IMANUF.EQ.'X11 ')THEN
2825        GOTO9600
2826      ELSEIF(IMANUF.EQ.'AQUA')THEN
2827        GOTO13500
2828      ELSEIF(IMANUF.EQ.'GENE')THEN
2829        IF(IMODEL.EQ.'CODE')GOTO3200
2830        IF(IMODEL.EQ.'CGM')GOTO3300
2831        IF(IMODEL.EQ.'CGMB')GOTO3400
2832        GOTO3100
2833      ELSEIF(IMANUF.EQ.'SVG ')THEN
2834        GOTO16000
2835      ELSEIF(IMANUF.EQ.'GD  ')THEN
2836        GOTO12000
2837      ELSEIF(IMANUF.EQ.'LATE')THEN
2838        GOTO15000
2839      ELSEIF(IMANUF.EQ.'CAIR')THEN
2840        GOTO17000
2841      ELSEIF(IMANUF.EQ.'D3  ')THEN
2842        GOTO19000
2843      ELSEIF(IMANUF.EQ.'WMF ')THEN
2844        GOTO18000
2845      ELSEIF(IMANUF.EQ.'OPGL')THEN
2846        GOTO4800
2847      ELSEIF(IMANUF.EQ.'CAIR')THEN
2848        GOTO17000
2849      ELSEIF(IMANUF.EQ.'D3  ')THEN
2850        GOTO19000
2851      ELSEIF(IMANUF.EQ.'WMF ')THEN
2852        GOTO18000
2853      ELSEIF(IMANUF.EQ.'TEKT')THEN
2854        GOTO1100
2855      ELSEIF(IMANUF.EQ.'HP')THEN
2856        IF(IMODEL.EQ.'7221')GOTO2100
2857        IF(IMODEL.EQ.'2622')GOTO2300
2858        IF(IMODEL.EQ.'2623')GOTO2300
2859        IF(IMODEL.EQ.'2627')GOTO2300
2860        IF(IMODEL.EQ.'2647')GOTO2300
2861        GOTO2200
2862      ELSEIF(IMANUF.EQ.'LIBP')THEN
2863        GOTO2600
2864      ELSEIF(IMANUF.EQ.'REGI')THEN
2865        GOTO8100
2866      ELSEIF(IMANUF.EQ.'GKS ')THEN
2867        GOTO11000
2868      ELSEIF(IMANUF.EQ.'LAHE')THEN
2869        IF(IMODEL.EQ.'INTE')GOTO4900
2870        IF(IMODEL.EQ.'WINT')GOTO4950
2871        GOTO4600
2872      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
2873        GOTO13000
2874      ELSEIF(IMANUF.EQ.'QUIC')THEN
2875        GOTO9100
2876      ELSEIF(IMANUF.EQ.'CALC')THEN
2877        GOTO4100
2878      ELSEIF(IMANUF.EQ.'ZETA')THEN
2879        GOTO5100
2880      ELSEIF(IMANUF.EQ.'TURB')THEN
2881        GOTO10000
2882      ELSEIF(IMANUF.EQ.'SUN ')THEN
2883        GOTO6600
2884      ENDIF
2885      GOTO9000
2886C
2887C               ******************************************************
2888C               **  STEP 11--                                       **
2889C               **  TREAT THE TEKTRONIX 4014 (ETC.) CASE            **
2890C               ******************************************************
2891C
2892CCCCC SEPTEMBER 1995.  ADD "PIXEL" CAPABILITY.
2893 1100 CONTINUE
2894      WRITE(ICOUT,1162)
2895 1162 FORMAT('****** THE IMAGE CAPABILITY IS NOT SUPPORTED FOR ',
2896     1       'THE TEKTRONIX DEVICE.')
2897      CALL DPWRST('XXX','BUG ')
2898      GOTO9000
2899C
2900C               ******************************************************
2901C               **  STEP 21--                                       **
2902C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
2903C               **  (MULTI-COLOR PENPLOTTER)                        **
2904C               **  TO DRAW A HORIZONTAL POLYMARKER--               **
2905C               **  USE THE p (= MOVE) INSTRUCTION                  **
2906C               **  AND PACKED BINARY COORDINATES,                  **
2907C               **  AND THE ~' (= INVOKE LABEL MODE) INSTRUCTION    **
2908C               **  AND THE DESIRED TEXT STRING,                    **
2909C               **  AND ETX TO DENOTE THE END OF TEXT STRING,       **
2910C               **  (WITH TRAILING RIGHT CURLY BRACKET WHICH IS THE **
2911C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
2912C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
2913C               **             OPERATING AND PROGRAMMING MANUAL,    **
2914C               **             PAGE 80-85, 253-254.                 **
2915C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
2916C               **             OPERATING AND PROGRAMMING MANUAL,    **
2917C               **             PAGE 111 AND 112.                    **
2918C               ******************************************************
2919C
2920 2100 CONTINUE
2921C
2922      WRITE(ICOUT,2162)
2923 2162 FORMAT('****** THE IMAGE CAPABILITY IS NOT SUPPORTED FOR ',
2924     1       'THE HP-7221 DEVICE.')
2925      CALL DPWRST('XXX','BUG ')
2926      GOTO9000
2927C
2928C               ******************************************************
2929C               **  STEP 22--                                       **
2930C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
2931C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
2932C               **  (MULTI-COLOR PENPLOTTERS)                       **
2933C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
2934C               **             OPERATING AND PROGRAMMING MANUAL,    **
2935C               **             PAGE 62, 143.                        **
2936C               **             PAGE 65-67, 143.                     **
2937C               **             PAGE 75, 141.                        **
2938C               ******************************************************
2939C
2940 2200 CONTINUE
2941      WRITE(ICOUT,2262)
2942 2262 FORMAT('****** THE IMAGE CAPABILITY IS NOT SUPPORTED FOR ',
2943     1       'THE HP-GL DEVICE.')
2944      CALL DPWRST('XXX','BUG ')
2945      GOTO9000
2946C
2947C               **********************************************************
2948C               **  STEP 23--                                           **
2949C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
2950C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
2951C               **  (MONOCHROME DISPLAY TERMINALS)                      **
2952C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
2953C               **             REFERENCE MANUAL,                        **
2954C               **             PAGE 10-12, 10-13, 10-21.
2955C               **********************************************************
2956C
2957 2300 CONTINUE
2958      WRITE(ICOUT,2362)
2959 2362 FORMAT('****** THE IMAGE CAPABILITY IS NOT SUPPORTED FOR ',
2960     1       'THE HP-2622 DEVICE.')
2961      CALL DPWRST('XXX','BUG ')
2962      GOTO9000
2963C
2964C               **********************************************************
2965C               **  STEP 26--                                           **
2966C               **  TREAT THE LIBPLOT LIBRARY         CASE              **
2967C               **********************************************************
2968C
2969 2600 CONTINUE
2970      GOTO9000
2971C
2972C               ******************************************************
2973C               **  STEP 31--                                       **
2974C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
2975C               ******************************************************
2976C
2977 3100 CONTINUE
2978C
2979      WRITE(ICOUT,3102)
2980 3102 FORMAT('****** THE IMAGE CAPABILITY IS NOT SUPPORTED FOR ',
2981     1       'THE GENERAL DEVICE.')
2982      CALL DPWRST('XXX','BUG ')
2983      GOTO9000
2984C
2985C               ***************************************************************
2986C               **  STEP 32--                                                **
2987C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
2988C               ***************************************************************
2989C
2990 3200 CONTINUE
2991      WRITE(ICOUT,3202)
2992 3202 FORMAT('****** THE IMAGE CAPABILITY IS NOT SUPPORTED FOR ',
2993     1       'THE GENERAL DEVICE.')
2994      CALL DPWRST('XXX','BUG ')
2995      GOTO9000
2996C
2997C               ***************************************************************
2998C               **  STEP 33--                                                **
2999C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
3000C               **  TEXT (XCOOR,YCOOR) FINAL "<SYMBOL>";                     **
3001C               ***************************************************************
3002C
3003 3300 CONTINUE
3004C
3005      WRITE(ICOUT,3302)
3006 3302 FORMAT('****** THE IMAGE CAPABILITY IS NOT SUPPORTED FOR ',
3007     1       'THE CGM DEVICE.')
3008      CALL DPWRST('XXX','BUG ')
3009      GOTO9000
3010C
3011C               ***************************************************
3012C               **  STEP 34--                                    **
3013C               **  TREAT THE CGM (BINARY)                 CASE  **
3014C               ***************************************************
3015C
3016 3400 CONTINUE
3017      GOTO9000
3018C
3019C               ******************************************************
3020C               **  STEP 41--                                       **
3021C               **  TREAT THE CALCOMP XXXXXX CASE                   **
3022C               **  TO DRAW A HORIZONTAL POLYMARKER--               **
3023C               **  WRITE OUT AN XXXXXXXXXX                         **
3024C               **  (NOT DONE)                                      **
3025C               **  REFERENCE--XX                                   **
3026C               **             XX                                   **
3027C               **             PAGES XX AND XX                      **
3028C               **  USE CALCOMP LIBRARY                             **
3029C               **      SYMBOL - WRITES TEXT                        **
3030C               **      CALCPT - DATAPLOT ROUTINE TO CONVERT FROM   **
3031C               **               PERCENT UNITS TO INCHES            **
3032C               **      CALCTR - DATAPLOT ROUTINE TO CONVERT        **
3033C               **               CHARACTER VARIABLE TO HOLLERITH    **
3034C               **               FORMAT (NOT NECCESARY ON ALL       **
3035C               **               SYSTEMS, BUT IS ON OTHERS.         **
3036C               ******************************************************
3037C
3038 4100 CONTINUE
3039C
3040      WRITE(ICOUT,4162)
3041 4162 FORMAT('****** THE IMAGE CAPABILITY IS NOT SUPPORTED FOR ',
3042     1       'THE CALCOMP DEVICE.')
3043      CALL DPWRST('XXX','BUG ')
3044      GOTO9000
3045C
3046C               ******************************************************
3047C               **  STEP 46--                                       **
3048C               **  TREAT THE LAHEY   XXXXXX CASE                   **
3049C               **  REFERENCE--Programmer's Reference, Revision C   **
3050C               **             Lahey Computer Systems, January, 1992**
3051C               **             PAGES 51 THRU 65                     **
3052C               ******************************************************
3053C
3054 4600 CONTINUE
3055C
3056#ifdef HAVE_LAHEY_CALCOMP
3057      CALL GRINFO(ILAHEY,RLAHEY,CLAHEY)
3058      IPEN=JCOL
3059      DO4670I=1,NP
3060        PX1=PX(I)
3061        PY1=PY(I)
3062        CALL CALCPT(PX1,PY1,AX,AY,ISUBN0)
3063        CALL SETPIX(AX,AY,IPEN)
3064C       DO4675IROW=IX,IX+NCOL-1
3065C         DO4678ICOLZ=IY,IY+NCOL-1
3066C           AX2=AX+REAL(IX-IROW)
3067C           AY2=AY+REAL(IY-ICOL)
3068C           CALL SETPIX(AX,AY,IPEN)
3069C4678     CONTINUE
3070C4675   CONTINUE
3071 4670 CONTINUE
3072C
3073#endif
3074      GOTO9000
3075C
3076C               ******************************************************
3077C               **  STEP 47--                                       **
3078C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
3079C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
3080C               ******************************************************
3081C
3082 4700 CONTINUE
3083C
3084      NSIZE=INT(PHEIGH)
3085      IF(NSIZE.LT.1)NSIZE=1
3086      CALL GRTRSD(PXMIN,PYMAX,IXSTRT,IYSTRT,ISUBN0)
3087      CALL GRTRSD(PXMAX,PYMIN,IXSTOP,IYSTOP,ISUBN0)
3088      PY000=0.0
3089      CALL GRTRSD(PXMIN,PY000,IXSTRT,IY000,ISUBN0)
3090      PY100=100.0
3091      CALL GRTRSD(PXMIN,PY100,IXSTRT,IY100,ISUBN0)
3092C
3093      ITFLAG=0
3094      DO4770I=1,NP
3095        PX1=PX(I)
3096        PY1=PY(I)
3097        IX1=INT(PX1+0.1)
3098        IY1=INT(PY1+0.1)
3099        IXCOOR=IXSTRT + (IX1-1)*NSIZE + 1
3100        IYCOOR=IYSTRT + (IY1-1)*NSIZE + 1
3101        IF(IXCOOR.GT.IXSTOP .OR. IYCOOR.GT.IYSTOP)THEN
3102          ITFLAG=1
3103         GOTO4770
3104        ENDIF
3105C
3106        IF(ICASCO.EQ.'RGB')THEN
3107          AVAL=YRED(I)*255.
3108          IVAL=INT(AVAL+0.5)
3109          IF(IVAL.LT.0)IVAL=0
3110          IF(IVAL.GT.255)IVAL=255
3111          IVAL1=IVAL
3112          AVAL=YGREEN(I)*255.
3113          IVAL=INT(AVAL+0.5)
3114          IF(IVAL.LT.0)IVAL=0
3115          IF(IVAL.GT.255)IVAL=255
3116          IVAL2=IVAL
3117          AVAL=YBLUE(I)*255.
3118          IVAL=INT(AVAL+0.5)
3119          IF(IVAL.LT.0)IVAL=0
3120          IF(IVAL.GT.255)IVAL=255
3121          IVAL3=IVAL
3122#ifdef HAVE_QWIN
3123          JTEMP2=RGBTOINTEGER(IVAL1,IVAL2,IVAL3)
3124          ISTATUS=SETCOLORRGB(JTEMP)
3125#endif
3126        ELSE
3127          AVAL=YRED(I)*255.
3128          IVAL=INT(AVAL+0.5)
3129          IF(IVAL.LT.0)IVAL=0
3130          IF(IVAL.GT.255)IVAL=255
3131          JTEMP=IVAL
3132#ifdef HAVE_QWIN
3133          JTEMP2=RGBTOINTEGER(JTEMP,JTEMP,JTEMP)
3134          ISTATUS=SETCOLORRGB(JTEMP2)
3135#endif
3136        ENDIF
3137C
3138        DO4775IROWZ=IXCOOR,IXCOOR+NSIZE-1
3139          DO4778ICOLZ=IYCOOR,IYCOOR+NSIZE-1
3140            IXTEMP=IROWZ
3141            IYTEMP=IY000 - ICOLZ
3142            IF(IXTEMP.GT.IXSTOP .OR. IYTEMP.GT.IYSTOP)THEN
3143              ITFLAG=1
3144              GOTO4770
3145            ENDIF
3146#ifdef HAVE_QWIN
3147            IRESLT=SETPIXELRGB(INT2(IXTEMP),INT2(IYTEMP),JTEMP2)
3148#endif
3149 4778     CONTINUE
3150 4775   CONTINUE
3151 4770 CONTINUE
3152C
3153      IF(ITFLAG.EQ.1)THEN
3154        WRITE(ICOUT,999)
3155        CALL DPWRST('XXX','BUG ')
3156        WRITE(ICOUT,4791)
3157 4791   FORMAT('***** WARNING: PART OF IMAGE TRUNCATED FOR')
3158        CALL DPWRST('XXX','BUG ')
3159        WRITE(ICOUT,4792)
3160 4792   FORMAT('      THE QUICK-WIN (WINDOWS) DEVICE.')
3161        CALL DPWRST('XXX','BUG ')
3162      ENDIF
3163C
3164      GOTO9000
3165C
3166C               ******************************************************
3167C               **  STEP 48--                                       **
3168C               **  TREAT THE OPEN-GL DRIVER                        **
3169C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
3170C               ******************************************************
3171C
3172 4800 CONTINUE
3173C
3174      NCOL=INT(PHEIGH)
3175      IF(NCOL.LT.1)NCOL=1
3176      IF(IFONTH.EQ.0)THEN
3177        IXINC=0
3178      ELSEIF(IFONTH.EQ.1)THEN
3179        IXINC=NCOL/2
3180      ELSE
3181        IXINC=NCOL
3182      ENDIF
3183      IF(IFONTV.EQ.0)THEN
3184        IYINC=0
3185      ELSEIF(IFONTV.EQ.1)THEN
3186        IYINC=NCOL/2
3187      ELSE
3188        IYINC=NCOL
3189      ENDIF
3190C
3191      DO4870I=1,NP
3192        PX1=PX(I)
3193        PY1=PY(I)
3194        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
3195        DO4875IROW=IX,IX+NCOL-1
3196          DO4878ICOLZ=IY,IY-NCOL+1,-1
3197            IXTEMP=IROW-IXINC
3198            IYTEMP=ICOLZ+IYINC
3199#ifdef HAVE_OPEN_GL
3200            CALL GLPOIN(IXTEMP,IYTEMP,PHEIGH)
3201#endif
3202 4878     CONTINUE
3203 4875   CONTINUE
3204 4870 CONTINUE
3205C
3206      GOTO9000
3207C
3208C               ******************************************************
3209C               **  STEP 49--                                       **
3210C               **  TREAT THE LAHEY INTERACTOR CASE                 **
3211C               ******************************************************
3212C
3213 4900 CONTINUE
3214C
3215      NCOL=INT(PHEIGH)
3216      IF(NCOL.LT.1)NCOL=1
3217      IF(IFONTH.EQ.0)THEN
3218        IXINC=0
3219      ELSEIF(IFONTH.EQ.1)THEN
3220        IXINC=NCOL/2
3221      ELSE
3222        IXINC=NCOL
3223      ENDIF
3224      IF(IFONTV.EQ.0)THEN
3225        IYINC=0
3226      ELSEIF(IFONTV.EQ.1)THEN
3227        IYINC=NCOL/2
3228      ELSE
3229        IYINC=NCOL
3230      ENDIF
3231      DO4938I=1,NP
3232#ifdef HAVE_INTERACTER
3233        CALL IGrPoint(PX(I),PY(I))
3234#endif
3235 4938 CONTINUE
3236      GOTO9000
3237C
3238C               ******************************************************
3239C               **  STEP 49B-                                       **
3240C               **  TREAT THE LAHEY WINTERACTOR CASE                **
3241C               ******************************************************
3242C
3243 4950 CONTINUE
3244C
3245      NCOL=INT(PHEIGH)
3246      IF(NCOL.LT.1)NCOL=1
3247      DO4988I=1,NP
3248#ifdef HAVE_WININTERACTER
3249        CALL IGrPoint(PX(I),PY(I))
3250#endif
3251 4988 CONTINUE
3252      GOTO9000
3253C
3254C
3255C               ******************************************************
3256C               **  STEP 41--                                       **
3257C               **  TREAT THE CALCOMP XXXXXX CASE                   **
3258C               **  TO DRAW A HORIZONTAL POLYMARKER--               **
3259C               **  WRITE OUT AN XXXXXXXXXX                         **
3260C               **  (NOT DONE)                                      **
3261C               **  REFERENCE--XX                                   **
3262C               **             XX                                   **
3263C               **             PAGES XX AND XX                      **
3264C               **  USE CALCOMP LIBRARY                             **
3265C               **      SYMBOL - WRITES TEXT                        **
3266C               **      CALCPT - DATAPLOT ROUTINE TO CONVERT FROM   **
3267C               **               PERCENT UNITS TO INCHES            **
3268C               **      CALCTR - DATAPLOT ROUTINE TO CONVERT        **
3269C               **               CHARACTER VARIABLE TO HOLLERITH    **
3270C               **               FORMAT (NOT NECCESARY ON ALL       **
3271C               **               SYSTEMS, BUT IS ON OTHERS.         **
3272C               ******************************************************
3273C
3274 5100 CONTINUE
3275C
3276      WRITE(ICOUT,5162)
3277 5162 FORMAT('****** THE IMAGE CAPABILITY IS NOT YET SUPPORTED FOR ',
3278     1       'THE ZETA DEVICE.')
3279      CALL DPWRST('XXX','BUG ')
3280      GOTO9000
3281C
3282C               ******************************************************
3283C               **  STEP 66--                                       **
3284C               **  TREAT THE SUN CASE                              **
3285C               **  WRITTEN BY BILL ANDERSON                        **
3286C               ******************************************************
3287C
3288 6600 CONTINUE
3289C
3290      WRITE(ICOUT,6602)
3291 6602 FORMAT('****** THE IMAGE CAPABILITY IS NOT SUPPORTED FOR ',
3292     1       'THE SUN DEVICE.')
3293      CALL DPWRST('XXX','BUG ')
3294      GOTO9000
3295C
3296C               ******************************************************
3297C               **  STEP 81--                                       **
3298C               **  TREAT THE DEC  REGIS CASE                       **
3299C               **  TO DRAW A HORIZONTAL POLYMARKER--               **
3300C               **  USE THE P [ X, Y ] (= POSITION) INSTRUCTION     **
3301C               **  WITH INTEGER COORDINATES,                       **
3302C               **  AND THE   T ' STRING '  (= TEXT) INSTRUCTION    **
3303C               **  WITH THE DESIRED TEXT STRING,                   **
3304C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
3305C               **             PAGES 100 AND 118                    **
3306C               ******************************************************
3307C
3308 8100 CONTINUE
3309C
3310      WRITE(ICOUT,8102)
3311 8102 FORMAT('****** THE IMAGE CAPABILITY IS NOT SUPPORTED FOR ',
3312     1       'THE DEC REGIS DEVICE.')
3313      CALL DPWRST('XXX','BUG ')
3314      GOTO9000
3315C
3316C               ******************************************************
3317C               **  STEP 86--                                       **
3318C               **  TREAT THE POSTSCRIPT CASE                       **
3319C               ******************************************************
3320C
3321 8600 CONTINUE
3322C
3323C     FOR POSTSCRIPT, NEED TO ROTATE (I.E., REVERSE ROLES OF
3324C     ROWS AND COLUMNS).
3325C
3326      NSIZE=INT(PHEIGH)
3327      IF(NSIZE.LT.1)NSIZE=1
3328C
3329      NCOLST=NCOLS
3330      NROWST=NROWS
3331      NCOLS=NROWST
3332      NROWS=NCOLST
3333C
3334      NCOLS2=NCOLS*NSIZE
3335      NROWS2=NROWS*NSIZE
3336C
3337      CALL GRTRSD(PXMIN,PYMAX,IXSTRT,IYSTRT,ISUBN0)
3338      CALL GRTRSD(PXMAX,PYMIN,IXSTOP,IYSTOP,ISUBN0)
3339C
3340C     SAVE CURRENT GRAPHICS STATE
3341C
3342      ICSTR(1:38)='gsave   %  Save current graphics state'
3343      NCSTR=38
3344      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3345C
3346C     CASE 1: RGB CASE
3347C
3348      IF(ICASCO.EQ.'RGB')THEN
3349C
3350        ICSTR='/picstr '
3351        NCSTR=8
3352        NTEMP=3*NCOLS
3353        NCHTOT=5
3354        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3355        NCSTR=NCSTR+1
3356        ICSTR(NCSTR:NCSTR+10)=' string def'
3357        NCSTR=NCSTR+10
3358        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3359C
3360        NCSTR=0
3361        NCHTOT=5
3362        NTEMP=IXSTRT
3363        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3364        NCSTR=NCSTR+1
3365        ICSTR(NCSTR:NCSTR)=' '
3366        NTEMP=IYSTRT - NROWS2
3367        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3368        NCSTR=NCSTR+1
3369        ICSTR(NCSTR:NCSTR+9)=' translate'
3370        NCSTR=NCSTR+9
3371        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3372C
3373        NCSTR=0
3374        NCHTOT=5
3375        NTEMP=NSIZE*NCOLS
3376        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3377        NCSTR=NCSTR+1
3378        ICSTR(NCSTR:NCSTR)=' '
3379        NTEMP=NSIZE*NROWS
3380        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3381        NCSTR=NCSTR+1
3382        ICSTR(NCSTR:NCSTR+5)=' scale'
3383        NCSTR=NCSTR+5
3384        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3385C
3386        NCSTR=0
3387        NCHTOT=5
3388        NTEMP=NROWS
3389        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3390        NCSTR=NCSTR+1
3391        ICSTR(NCSTR:NCSTR)=' '
3392        NTEMP=NCOLS
3393        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3394        NCSTR=NCSTR+1
3395        ICSTR(NCSTR:NCSTR+1)=' 8'
3396        NCSTR=NCSTR+1
3397        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3398C
3399        NCSTR=0
3400        ICSTR(1:1)='['
3401        NCSTR=1
3402        NCHTOT=5
3403        NTEMP=NCOLS
3404        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3405        NCSTR=NCSTR+1
3406        ICSTR(NCSTR:NCSTR+4)=' 0 0 '
3407        NCSTR=NCSTR+4
3408        NTEMP=-NROWS
3409        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3410        NCSTR=NCSTR+1
3411        ICSTR(NCSTR:NCSTR+1)=' 0 '
3412        NCSTR=NCSTR+1
3413        NTEMP=NROWS
3414        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3415        NCSTR=NCSTR+1
3416        ICSTR(NCSTR:NCSTR)=']'
3417        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3418C
3419        NCSTR=0
3420        ICSTR(1:38)='{currentfile picstr readhexstring pop}'
3421        NCSTR=38
3422        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3423        ICSTR(1:7)='false 3'
3424        NCSTR=7
3425        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3426        ICSTR(1:10)='colorimage'
3427        NCSTR=10
3428        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3429C
3430C       FOR POSTSCRIPT: SEND THE IMAGE ONE ROW AT A TIME.
3431C       WE ARE SENDING 8-BIT DATA (0 - 255), SO THERE WILL BE
3432C       2 HEX DIGITS FOR EACH RGB COMPONENT.
3433C
3434C       WE ASSUME THAT THE DATA IS ALREADY SORTED IN ROW ORDER
3435C
3436        IBUGG4='OFF'
3437        ICNT=0
3438        NCSTR=0
3439C
3440        DO8610I=1,NROWS
3441          DO8620J=1,NCOLS
3442C
3443            ICNT=ICNT+1
3444            IF(ICNT.GT.NP)GOTO8619
3445C
3446            AVAL=YRED(ICNT)*255.
3447            IVAL=INT(AVAL+0.5)
3448            IF(IVAL.LT.0)IVAL=0
3449            IF(IVAL.GT.255)IVAL=255
3450            IVAL1=IVAL
3451            CALL DECHE2(IVAL1,ICJUNK,IBUGG4,IERROR)
3452            NCSTR=NCSTR+1
3453            ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
3454            NCSTR=NCSTR+1
3455C
3456            AVAL=YGREEN(ICNT)*255.
3457            IVAL=INT(AVAL+0.5)
3458            IF(IVAL.LT.0)IVAL=0
3459            IF(IVAL.GT.255)IVAL=255
3460            IVAL2=IVAL
3461            CALL DECHE2(IVAL2,ICJUNK,IBUGG4,IERROR)
3462            NCSTR=NCSTR+1
3463            ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
3464            NCSTR=NCSTR+1
3465C
3466            AVAL=YBLUE(ICNT)*255.
3467            IVAL=INT(AVAL+0.5)
3468            IF(IVAL.LT.0)IVAL=0
3469            IF(IVAL.GT.255)IVAL=255
3470            IVAL3=IVAL
3471            CALL DECHE2(IVAL2,ICJUNK,IBUGG4,IERROR)
3472            NCSTR=NCSTR+1
3473            ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
3474            NCSTR=NCSTR+1
3475C
3476            IF(NCSTR.GT.120)THEN
3477              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3478              NCSTR=0
3479            ENDIF
3480C
3481 8620     CONTINUE
3482C
3483          IF(NCSTR.GT.0)THEN
3484            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3485            NCSTR=0
3486          ENDIF
3487C
3488 8610   CONTINUE
3489 8619   CONTINUE
3490C
3491        IF(NCSTR.GT.0)THEN
3492          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3493          NCSTR=0
3494        ENDIF
3495C
3496      ELSE
3497C
3498        ICSTR='/picstr '
3499        NCSTR=8
3500        NTEMP=NCOLS
3501        NCHTOT=5
3502        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3503        NCSTR=NCSTR+1
3504        ICSTR(NCSTR:NCSTR+10)=' string def'
3505        NCSTR=NCSTR+10
3506        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3507C
3508        NCSTR=0
3509        NCHTOT=5
3510        NTEMP=IXSTRT
3511        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3512        NCSTR=NCSTR+1
3513        ICSTR(NCSTR:NCSTR)=' '
3514        NTEMP=IYSTRT - NROWS2
3515        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3516        NCSTR=NCSTR+1
3517        ICSTR(NCSTR:NCSTR+9)=' translate'
3518        NCSTR=NCSTR+9
3519        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3520C
3521        NCSTR=0
3522        NCHTOT=5
3523        NTEMP=NSIZE*NCOLS
3524        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3525        NCSTR=NCSTR+1
3526        ICSTR(NCSTR:NCSTR)=' '
3527        NTEMP=NSIZE*NROWS
3528        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3529        NCSTR=NCSTR+1
3530        ICSTR(NCSTR:NCSTR+5)=' scale'
3531        NCSTR=NCSTR+5
3532        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3533C
3534        NCSTR=0
3535        NCHTOT=5
3536        NTEMP=NCOLS
3537        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3538        NCSTR=NCSTR+1
3539        ICSTR(NCSTR:NCSTR)=' '
3540        NTEMP=NROWS
3541        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3542        NCSTR=NCSTR+1
3543        ICSTR(NCSTR:NCSTR+1)=' 8'
3544        NCSTR=NCSTR+1
3545        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3546C
3547        NCSTR=0
3548        ICSTR(1:1)='['
3549        NCSTR=1
3550        NCHTOT=5
3551        NTEMP=NCOLS
3552        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3553        NCSTR=NCSTR+1
3554        ICSTR(NCSTR:NCSTR+4)=' 0 0 '
3555        NCSTR=NCSTR+4
3556        NTEMP=-NROWS
3557        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3558        NCSTR=NCSTR+1
3559        ICSTR(NCSTR:NCSTR+1)=' 0 '
3560        NCSTR=NCSTR+1
3561        NTEMP=NROWS
3562        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
3563        NCSTR=NCSTR+1
3564        ICSTR(NCSTR:NCSTR)=']'
3565        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3566C
3567        NCSTR=0
3568        ICSTR(1:38)='{currentfile picstr readhexstring pop}'
3569        NCSTR=38
3570        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3571        ICSTR(1:5)='image'
3572        NCSTR=5
3573        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3574C
3575C       FOR POSTSCRIPT: SEND THE IMAGE ONE ROW AT A TIME.
3576C       WE ARE SENDING 8-BIT DATA (0 - 255), SO THERE WILL BE
3577C       2 HEX DIGITS FOR EACH RGB COMPONENT.
3578C
3579C       WE ASSUME THAT THE DATA IS ALREADY SORTED IN ROW ORDER
3580C       FOR POSTSCRIPT:
3581C
3582        IBUGG4='OFF'
3583        ICNT=0
3584        NCSTR=0
3585C
3586        DO8710I=1,NROWS
3587          DO8720J=1,NCOLS
3588C
3589            ICNT=ICNT+1
3590            IF(ICNT.GT.NP)GOTO8719
3591C
3592            AVAL=YRED(ICNT)*255.
3593            IVAL=INT(AVAL+0.5)
3594            IF(IVAL.LT.0)IVAL=0
3595            IF(IVAL.GT.255)IVAL=255
3596            IVAL1=IVAL
3597            CALL DECHE2(IVAL1,ICJUNK,IBUGG4,IERROR)
3598            NCSTR=NCSTR+1
3599            ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
3600            NCSTR=NCSTR+1
3601C
3602            IF(NCSTR.GT.128)THEN
3603              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3604              NCSTR=0
3605            ENDIF
3606C
3607 8720     CONTINUE
3608C
3609          IF(NCSTR.GT.0)THEN
3610            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3611            NCSTR=0
3612          ENDIF
3613C
3614 8710   CONTINUE
3615 8719   CONTINUE
3616C
3617        IF(NCSTR.GT.0)THEN
3618          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3619          NCSTR=0
3620        ENDIF
3621C
3622      ENDIF
3623C
3624C     RESTORE CURRENT GRAPHICS STATE
3625C
3626      ICSTR(1:15)='%  End of Image'
3627      NCSTR=15
3628      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3629      ICSTR(1:35)='grestore  %  Restore graphics state'
3630      NCSTR=35
3631      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
3632C
3633      GOTO9000
3634C
3635C               ******************************************************
3636C               **  STEP 91--                                       **
3637C               **  TREAT THE QUIC LANDSCAPE AND PORTRAIT CASE      **
3638C               **  <ICARAT>IVvvvvv   - VERTICAL POSITION           **
3639C               **  <ICARAT>IHhhhhh   - HORIZONTAL POSITION         **
3640C               **  REFERENCE: QUIC PROGRAMMERS MANUAL -            **
3641C               **                                                  **
3642C               ******************************************************
3643C
3644 9100 CONTINUE
3645C
3646      WRITE(ICOUT,9162)
3647 9162 FORMAT('****** THE IMAGE CAPABILITY IS NOT SUPPORTED FOR ',
3648     1       'THE QUIC QMS DEVICE.')
3649      CALL DPWRST('XXX','BUG ')
3650      GOTO9000
3651C
3652C               ******************************************************
3653C               **  STEP 95--                                       **
3654C               **  TREAT THE X11        CASE                       **
3655C               ******************************************************
3656C
3657 9600 CONTINUE
3658C
3659#ifdef HAVE_X11
3660      IF(IX11OF.EQ.'OFF')GOTO9000
3661C
3662      NSIZE=INT(PHEIGH)
3663      IF(NSIZE.LT.1)NSIZE=1
3664      CALL GRTRSD(PXMIN,PYMAX,IXSTRT,IYSTRT,ISUBN0)
3665      CALL GRTRSD(PXMAX,PYMIN,IXSTOP,IYSTOP,ISUBN0)
3666      PY000=0.0
3667      CALL GRTRSD(PXMIN,PY000,IXSTRT,IY000,ISUBN0)
3668      PY100=100.0
3669      CALL GRTRSD(PXMIN,PY100,IXSTRT,IY100,ISUBN0)
3670C
3671      ITFLAG=0
3672      DO9670I=1,NP
3673        PX1=PX(I)
3674        PY1=PY(I)
3675        IX1=INT(PX1+0.1)
3676        IY1=INT(PY1+0.1)
3677        IXCOOR=IXSTRT + (IX1-1)*NSIZE + 1
3678        IYCOOR=IYSTRT + (IY1-1)*NSIZE + 1
3679        IF(IXCOOR.GT.IXSTOP .OR. IYCOOR.GT.IYSTOP)THEN
3680          ITFLAG=1
3681         GOTO9670
3682        ENDIF
3683C
3684        IF(ICASCO.EQ.'RGB')THEN
3685          AVAL=YRED(I)*255.
3686          IVAL=INT(AVAL+0.5)
3687          IF(IVAL.LT.0)IVAL=0
3688          IF(IVAL.GT.255)IVAL=255
3689          IVAL1=IVAL
3690          AVAL=YGREEN(I)*255.
3691          IVAL=INT(AVAL+0.5)
3692          IF(IVAL.LT.0)IVAL=0
3693          IF(IVAL.GT.255)IVAL=255
3694          IVAL2=IVAL
3695          AVAL=YBLUE(I)*255.
3696          IVAL=INT(AVAL+0.5)
3697          IF(IVAL.LT.0)IVAL=0
3698          IF(IVAL.GT.255)IVAL=255
3699          IVAL3=IVAL
3700CCCCC     JTEMP2=RGBTOINTEGER(IVAL1,IVAL2,IVAL3)
3701CCCCC     ISTATUS=SETCOLORRGB(JTEMP)
3702        ELSE
3703CCCCC     AFACT=255.0
3704          AFACT=99.0
3705          IFACT=INT(AFACT+0.1)
3706          AVAL=YRED(I)*AFACT
3707          IVAL=INT(AVAL+0.5)
3708          IF(IVAL.LT.0)IVAL=0
3709          IF(IVAL.GT.IFACT)IVAL=IFACT
3710          JTEMP=-IVAL
3711          CALL XFORE(JTEMP)
3712        ENDIF
3713C
3714        DO9675IROWZ=IXCOOR,IXCOOR+NSIZE-1
3715          DO9678ICOLZ=IYCOOR,IYCOOR+NSIZE-1
3716            IXTEMP=IROWZ
3717            IYTEMP=IY000 - ICOLZ
3718            IF(IXTEMP.GT.IXSTOP .OR. IYTEMP.GT.IYSTOP)THEN
3719              ITFLAG=1
3720              GOTO9670
3721            ENDIF
3722            CALL XPOINT(IXTEMP,IYTEMP)
3723 9678     CONTINUE
3724 9675   CONTINUE
3725 9670 CONTINUE
3726C
3727      IF(ITFLAG.EQ.1)THEN
3728        WRITE(ICOUT,999)
3729        CALL DPWRST('XXX','BUG ')
3730        WRITE(ICOUT,9691)
3731 9691   FORMAT('***** WARNING: PART OF IMAGE TRUNCATED FOR')
3732        CALL DPWRST('XXX','BUG ')
3733        WRITE(ICOUT,9692)
3734 9692   FORMAT('      THE X11 DEVICE.')
3735        CALL DPWRST('XXX','BUG ')
3736      ENDIF
3737#endif
3738C
3739      GOTO9000
3740C
3741C               *************************************************
3742C               **  STEP 100--                                 **
3743C               **  TREAT THE VGA VIA TURBO-C       CASE       **
3744C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
3745C               **             ENHANCEMENTS, PAGE 124, 113.    **
3746C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
3747C               **             PAGE 324-325, 256.              **
3748C               **  REFERENCE--WEISKAMP, POWER GRAPHICS        **
3749C               **             USING TURBO C, PAGE 59-60, 54-55**
3750C               *************************************************
3751C
375210000 CONTINUE
3753C
3754      WRITE(ICOUT,10162)
375510162 FORMAT('****** THE IMAGE CAPABILITY IS NOT SUPPORTED FOR ',
3756     1       'THE TURBO=C DEVICE.')
3757      CALL DPWRST('XXX','BUG ')
3758      GOTO9000
3759C
3760C               ******************************************************
3761C               **  STEP 110--                                      **
3762C               **  TREAT THE GKS                DRIVER             **
3763C               ******************************************************
3764C
376511000 CONTINUE
3766      WRITE(ICOUT,11062)
376711062 FORMAT('****** THE IMAGE CAPABILITY IS NOT SUPPORTED FOR ',
3768     1       'THE GKS DEVICE.')
3769      CALL DPWRST('XXX','BUG ')
3770      GOTO9000
3771C
3772C               ******************************************************
3773C               **  STEP 120--                                      **
3774C               **  TREAT THE GD                     DRIVER         **
3775C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
3776C               **  1) JPEG                                         **
3777C               **  2) PNG                                          **
3778C               **  3) GIF                                          **
3779C               ******************************************************
3780C
378112000 CONTINUE
3782#ifdef HAVE_GD
3783C
3784      NSIZE=INT(PHEIGH)
3785      IF(NSIZE.LT.1)NSIZE=1
3786      CALL GRTRSD(PXMIN,PYMAX,IXSTRT,IYSTRT,ISUBN0)
3787      CALL GRTRSD(PXMAX,PYMIN,IXSTOP,IYSTOP,ISUBN0)
3788      PY000=0.0
3789      CALL GRTRSD(PXMIN,PY000,IXSTRT,IY000,ISUBN0)
3790      PY100=100.0
3791      CALL GRTRSD(PXMIN,PY100,IXSTRT,IY100,ISUBN0)
3792C
3793      ITFLAG=0
3794      DO12070I=1,NP
3795        PX1=PX(I)
3796        PY1=PY(I)
3797        IX1=INT(PX1+0.1)
3798        IY1=INT(PY1+0.1)
3799        IXCOOR=IXSTRT + (IX1-1)*NSIZE + 1
3800        IYCOOR=IYSTRT + (IY1-1)*NSIZE + 1
3801        IF(IXCOOR.GT.IXSTOP .OR. IYCOOR.GT.IYSTOP)THEN
3802          ITFLAG=1
3803         GOTO12070
3804        ENDIF
3805C
3806        IF(ICASCO.EQ.'RGB')THEN
3807          AVAL=YRED(I)*255.
3808          IVAL=INT(AVAL+0.5)
3809          IF(IVAL.LT.0)IVAL=0
3810          IF(IVAL.GT.255)IVAL=255
3811          IVAL1=IVAL
3812          AVAL=YGREEN(I)*255.
3813          IVAL=INT(AVAL+0.5)
3814          IF(IVAL.LT.0)IVAL=0
3815          IF(IVAL.GT.255)IVAL=255
3816          IVAL2=IVAL
3817          AVAL=YBLUE(I)*255.
3818          IVAL=INT(AVAL+0.5)
3819          IF(IVAL.LT.0)IVAL=0
3820          IF(IVAL.GT.255)IVAL=255
3821          IVAL3=IVAL
3822          CALL GDSEC2(IVAL1,IVAL2,IVAL3,IRETCO)
3823        ELSE
3824          AFACT=255.
3825          IFACT=INT(AFACT+0.1)
3826          AVAL=YRED(I)*AFACT
3827          IVAL=INT(AVAL+0.5)
3828          IF(IVAL.LT.0)IVAL=0
3829          IF(IVAL.GT.IFACT)IVAL=IFACT
3830          IVAL1=IVAL
3831          CALL GDSEC2(IVAL1,IVAL1,IVAL1,IRETCO)
3832        ENDIF
3833C
3834        JCOLT=1
3835        DO12075IROWZ=IXCOOR,IXCOOR+NSIZE-1
3836          DO12078ICOLZ=IYCOOR,IYCOOR+NSIZE-1
3837            IXTEMP=IROWZ
3838            IYTEMP=IY000 - ICOLZ
3839            IF(IXTEMP.GT.IXSTOP .OR. IYTEMP.GT.IYSTOP)THEN
3840              ITFLAG=1
3841              GOTO12070
3842            ENDIF
3843            CALL GDPOIN(IXTEMP,IYTEMP,JCOLT)
384412078     CONTINUE
384512075   CONTINUE
384612070 CONTINUE
3847      CALL GDSECO(JCOLT)
3848C
3849      IF(ITFLAG.EQ.1)THEN
3850        WRITE(ICOUT,999)
3851        CALL DPWRST('XXX','BUG ')
3852        WRITE(ICOUT,12091)
385312091   FORMAT('***** WARNING: PART OF IMAGE TRUNCATED FOR')
3854        CALL DPWRST('XXX','BUG ')
3855        WRITE(ICOUT,12092)
385612092   FORMAT('      THE GD DEVICE.')
3857        CALL DPWRST('XXX','BUG ')
3858      ENDIF
3859C
3860#endif
3861      GOTO9000
3862C
3863C               ******************************************************
3864C               **  STEP 130--                                      **
3865C               **  TREAT THE ABSOFT                 DRIVER         **
3866C               ******************************************************
3867C
386813000 CONTINUE
3869      GOTO9000
3870C
3871C               ******************************************************
3872C               **  STEP 135--                                      **
3873C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
3874C               ******************************************************
3875C
387613500 CONTINUE
3877C
3878C     NOTE 3/2008: THE AQPOIN ROUTINE IS CURRENTLY A NULL
3879C                  ROUTINE.  NEED TO FIX THIS IN ORDER FOR THE
3880C                  IMAGE CODE TO WORK.
3881C
3882      NSIZE=INT(PHEIGH)
3883      IF(NSIZE.LT.1)NSIZE=1
3884      CALL GRTRSD(PXMIN,PYMAX,IXSTRT,IYSTRT,ISUBN0)
3885      CALL GRTRSD(PXMAX,PYMIN,IXSTOP,IYSTOP,ISUBN0)
3886      PY000=0.0
3887      CALL GRTRSD(PXMIN,PY000,IXSTRT,IY000,ISUBN0)
3888      PY100=100.0
3889      CALL GRTRSD(PXMIN,PY100,IXSTRT,IY100,ISUBN0)
3890C
3891      ITFLAG=0
3892      DO13570I=1,NP
3893        PX1=PX(I)
3894        PY1=PY(I)
3895        IX1=INT(PX1+0.1)
3896        IY1=INT(PY1+0.1)
3897        IXCOOR=IXSTRT + (IX1-1)*NSIZE + 1
3898        IYCOOR=IYSTRT + (IY1-1)*NSIZE + 1
3899        IF(IXCOOR.GT.IXSTOP .OR. IYCOOR.GT.IYSTOP)THEN
3900          ITFLAG=1
3901         GOTO13570
3902        ENDIF
3903C
3904        IF(ICASCO.EQ.'RGB')THEN
3905          AVAL=YRED(I)*255.
3906          IVAL=INT(AVAL+0.5)
3907          IF(IVAL.LT.0)IVAL=0
3908          IF(IVAL.GT.255)IVAL=255
3909          IVAL1=IVAL
3910          AVAL=YGREEN(I)*255.
3911          IVAL=INT(AVAL+0.5)
3912          IF(IVAL.LT.0)IVAL=0
3913          IF(IVAL.GT.255)IVAL=255
3914          IVAL2=IVAL
3915          AVAL=YBLUE(I)*255.
3916          IVAL=INT(AVAL+0.5)
3917          IF(IVAL.LT.0)IVAL=0
3918          IF(IVAL.GT.255)IVAL=255
3919          IVAL3=IVAL
3920        ELSE
3921          AFACT=255.
3922          IFACT=INT(AFACT+0.1)
3923          AVAL=YRED(I)*AFACT
3924          IVAL=INT(AVAL+0.5)
3925          IF(IVAL.LT.0)IVAL=0
3926          IF(IVAL.GT.IFACT)IVAL=IFACT
3927          IVAL1=IVAL
3928          IVAL2=IVAL1
3929          IVAL3=IVAL1
3930        ENDIF
3931C
3932        JCOLT=1
3933        DO13575IROWZ=IXCOOR,IXCOOR+NSIZE-1
3934          DO13578ICOLZ=IYCOOR,IYCOOR+NSIZE-1
3935            IXTEMP=IROWZ
3936            IYTEMP=IY000 - ICOLZ
3937            IF(IXTEMP.GT.IXSTOP .OR. IYTEMP.GT.IYSTOP)THEN
3938              ITFLAG=1
3939              GOTO13570
3940            ENDIF
3941#ifdef HAVE_AQUA
3942            CALL AQPOIN(IXTEMP,IYTEMP,IVAL1,IVAL2,IVAL3)
3943#endif
394413578     CONTINUE
394513575   CONTINUE
394613570 CONTINUE
3947#ifdef HAVE_AQUA
3948      CALL AQSECO(JCOLT)
3949#endif
3950C
3951      IF(ITFLAG.EQ.1)THEN
3952        WRITE(ICOUT,999)
3953        CALL DPWRST('XXX','BUG ')
3954        WRITE(ICOUT,13591)
395513591   FORMAT('***** WARNING: PART OF IMAGE TRUNCATED FOR')
3956        CALL DPWRST('XXX','BUG ')
3957        WRITE(ICOUT,13592)
395813592   FORMAT('      THE AQUATERM DEVICE.')
3959        CALL DPWRST('XXX','BUG ')
3960      ENDIF
3961C
3962      GOTO9000
3963C
3964C               ******************************************************
3965C               **  STEP 150--                                      **
3966C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
3967C               ******************************************************
3968C
396915000 CONTINUE
3970C
3971C     FOR LATEX DRIVER, "PIXEL" MODE NOT CURRENTLY SUPPORTED
3972C
3973      GOTO9000
3974C
3975C               ******************************************************
3976C               **  STEP 160--                                      **
3977C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
3978C               ******************************************************
3979C
398016000 CONTINUE
3981C
3982      CALL DPCONA(34,IQUOTE)
3983C
3984C
3985CCCCC "PIXEL" OPTION: USE FILLED RECTANGLE TO DRAW
3986C
3987      NCOL=INT(PHEIGH)
3988      IF(NCOL.LT.1)NCOL=1
3989      IF(IFONTH.EQ.0)THEN
3990        IXINC=0
3991      ELSEIF(IFONTH.EQ.1)THEN
3992        IXINC=NCOL/2
3993      ELSE
3994        IXINC=NCOL
3995      ENDIF
3996      IF(IFONTV.EQ.0)THEN
3997        IYINC=0
3998      ELSEIF(IFONTV.EQ.1)THEN
3999        IYINC=NCOL/2
4000      ELSE
4001        IYINC=NCOL
4002      ENDIF
4003C
4004C
4005      DO16070I=1,NP
4006        PX1=PX(I)
4007        PY1=PY(I)
4008        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
4009        IX=IX-IXINC
4010        IY=IY-IYINC
4011        IX2=IX+NCOL-1
4012        IY2=IY+NCOL-1
4013
4014        ICSTR(1:11)='   <rect x='
4015        ICSTR(12:12)=IQUOTE
4016        NCSTR=12
4017        NCHTOT=5
4018        CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
4019        NCSTR=NCSTR+1
4020        ICSTR(NCSTR:NCSTR)=IQUOTE
4021        NCSTR=NCSTR+1
4022        ICSTR(NCSTR:NCSTR+2)=' y='
4023        NCSTR=NCSTR+3
4024        ICSTR(NCSTR:NCSTR)=IQUOTE
4025        CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
4026        NCSTR=NCSTR+1
4027        ICSTR(NCSTR:NCSTR)=IQUOTE
4028        NCSTR=-NCSTR
4029        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4030C
4031        ICSTR(1:15)='         width='
4032        ICSTR(16:16)=IQUOTE
4033        NCSTR=16
4034        CALL GRTRIN(NCOL,NCHTOT,ICSTR,NCSTR)
4035        NCSTR=NCSTR+1
4036        ICSTR(NCSTR:NCSTR)=IQUOTE
4037        NCSTR=NCSTR+1
4038        ICSTR(NCSTR:NCSTR+7)=' height='
4039        NCSTR=NCSTR+8
4040        ICSTR(NCSTR:NCSTR)=IQUOTE
4041        CALL GRTRIN(NCOL,NCHTOT,ICSTR,NCSTR)
4042        NCSTR=NCSTR+1
4043        ICSTR(NCSTR:NCSTR)=IQUOTE
4044        NCSTR=-NCSTR
4045        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4046C
4047        ICSTR(1:17)='           style='
4048        ICSTR(18:18)=IQUOTE
4049        ICSTR(19:31)='stroke:none; '
4050        NCSTR=-31
4051        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4052        ICSTR(1:19)='             fill:#'
4053        NCSTR=19
4054        NCHTOT=2
4055        ATEMP=255.
4056        AVAL1=YRED(I)/ATEMP
4057        AVAL2=YGREEN(I)/ATEMP
4058        AVAL3=YBLUE(I)/ATEMP
4059        JRED=INT(AVAL1)
4060        CALL DPCONX(JRED,ICJUNK)
4061        NCSTR=NCSTR+1
4062        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
4063        NCSTR=NCSTR+1
4064        JGREEN=INT(AVAL2)
4065        CALL DPCONX(JGREEN,ICJUNK)
4066        NCSTR=NCSTR+1
4067        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
4068        NCSTR=NCSTR+1
4069        JBLUE=INT(AVAL3)
4070        CALL DPCONX(JBLUE,ICJUNK)
4071        NCSTR=NCSTR+1
4072        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
4073        NCSTR=NCSTR+2
4074        ICSTR(NCSTR:NCSTR)=IQUOTE
4075        NCSTR=-NCSTR
4076        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4077        ICSTR(1:7)='     />'
4078        NCSTR=-7
4079        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
408016070 CONTINUE
4081      GOTO9000
4082C
4083C               ******************************************************
4084C               **  STEP 170--                                      **
4085C               **  TREAT THE CAIRO                          DRIVER **
4086C               ******************************************************
4087C
408817000 CONTINUE
4089C
4090#ifdef HAVE_CAIRO
4091      IVAL2=1
4092      IF(IGUNIT.EQ.IPL1NU)IVAL2=2
4093      IF(IGUNIT.EQ.IPL2NU)IVAL2=3
4094C
4095      NSIZE=INT(PHEIGH)
4096      IF(NSIZE.LT.1)NSIZE=1
4097      PXMINT=PXMIN
4098      PYMINT=PYMIN
4099      PXMAXT=PXMAX
4100      PYMAXT=PYMAX
4101      CALL GRTRSD(PXMINT,PYMINT,IXSTRT,IYSTRT,ISUBN0)
4102      CALL GRTRSD(PXMAXT,PYMAXT,IXSTOP,IYSTOP,ISUBN0)
4103      IF(IYSTRT.GT.IYSTOP)THEN
4104        IYTEMP=IYSTRT
4105        IYSTRT=IYSTOP
4106        IYSTOP=IYTEMP
4107      ENDIF
4108      PY000=0.0
4109      PY000T=0.0
4110      PXMINT=PXMIN
4111      CALL GRTRSD(PXMINT,PY000T,IXSTRT,IY000,ISUBN0)
4112      PY100=100.0
4113      PY100T=100.0
4114      PXMINT=PXMIN
4115      CALL GRTRSD(PXMINT,PY100T,IXSTRT,IY100,ISUBN0)
4116C
4117      ITFLAG=0
4118      DO17670I=1,NP
4119        PX1=PX(I)
4120        PY1=PY(I)
4121        IX1=INT(PX1+0.1)
4122        IY1=INT(PY1+0.1)
4123        IXCOOR=IXSTRT + (IX1-1)*NSIZE + 1
4124        IYCOOR=IYSTRT + (IY1-1)*NSIZE + 1
4125        IF(IXCOOR.GT.IXSTOP .OR. IYCOOR.GT.IYSTOP)THEN
4126          ITFLAG=1
4127CCCCC     GOTO17670
4128        ENDIF
4129C
4130        ATEMP=255.0
4131        IF(ICASCO.EQ.'RGB')THEN
4132          AVAL1=YRED(I)/ATEMP
4133          AVAL2=YGREEN(I)/ATEMP
4134          AVAL3=YBLUE(I)/ATEMP
4135          IF(AVAL1.LT.0.0)AVAL1=0.0
4136          IF(AVAL1.GT.1.0)AVAL1=1.0
4137          IF(AVAL2.LT.0.0)AVAL2=0.0
4138          IF(AVAL2.GT.1.0)AVAL2=1.0
4139          IF(AVAL3.LT.0.0)AVAL3=0.0
4140          IF(AVAL3.GT.1.0)AVAL3=1.0
4141          CALL CASECO(IVAL2,AVAL1,AVAL2,AVAL3)
4142        ELSE
4143CCCCC     AVAL1=YRED(I)/ATEMP
4144          AVAL1=YRED(I)
4145          IF(AVAL1.LT.0.0)AVAL1=0.0
4146          IF(AVAL1.GT.1.0)AVAL1=1.0
4147          CALL CASECO(IVAL2,AVAL1,AVAL1,AVAL1)
4148        ENDIF
4149C
4150        DO17675IROWZ=IXCOOR,IXCOOR+NSIZE-1
4151          DO17678ICOLZ=IYCOOR,IYCOOR+NSIZE-1
4152            IXTEMP=IROWZ
4153            IYTEMP=IY000 - ICOLZ
4154            IF(IXTEMP.GT.IXSTOP .OR. IYTEMP.GT.IYSTOP)THEN
4155              ITFLAG=1
4156              GOTO17670
4157            ENDIF
4158            CALL CAPOIN(IVAL2,IXTEMP,IYTEMP)
415917678     CONTINUE
416017675   CONTINUE
416117670 CONTINUE
4162C
4163      IF(ITFLAG.EQ.1)THEN
4164        WRITE(ICOUT,999)
4165        CALL DPWRST('XXX','BUG ')
4166        WRITE(ICOUT,17691)
416717691   FORMAT('***** WARNING: PART OF IMAGE TRUNCATED FOR')
4168        CALL DPWRST('XXX','BUG ')
4169        WRITE(ICOUT,17692)
417017692   FORMAT('      THE CAIRO DEVICE.')
4171        CALL DPWRST('XXX','BUG ')
4172      ENDIF
4173#endif
4174C
4175      GOTO9000
4176C
4177C               ******************************************************
4178C               **  STEP 180--                                      **
4179C               **  TREAT THE WMF                            DRIVER **
4180C               ******************************************************
4181C
418218000 CONTINUE
4183      GOTO9000
4184C
4185C               ******************************************************
4186C               **  STEP 190--                                      **
4187C               **  TREAT THE D3                             DRIVER **
4188C               ******************************************************
4189C
419019000 CONTINUE
4191      GOTO9000
4192C
4193C               *****************
4194C               **  STEP 90--  **
4195C               **  EXIT       **
4196C               *****************
4197C
4198 9000 CONTINUE
4199      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRIM')THEN
4200        WRITE(ICOUT,999)
4201        CALL DPWRST('XXX','BUG ')
4202        WRITE(ICOUT,9011)
4203 9011   FORMAT('***** AT THE END       OF GRDRIM--')
4204        CALL DPWRST('XXX','BUG ')
4205        WRITE(ICOUT,9012)NP,IMANUF,IGUNIT,IERRG4
4206 9012   FORMAT('NP,IMANUF,IGUNIT,IERRG4 = ',3I8,2X,A4)
4207        CALL DPWRST('XXX','BUG ')
4208        DO9015I=1,NP
4209          WRITE(ICOUT,9016)PX(I),PY(I)
4210 9016     FORMAT('PX(I),PY(I) = ',G15.7,G15.7)
4211          CALL DPWRST('XXX','BUG ')
4212 9015   CONTINUE
4213      ENDIF
4214C
4215      RETURN
4216      END
4217      SUBROUTINE GRDRLI(IX1,IY1,IX2,IY2,PX1,PY1,PX2,PY2,IFACTO,JCOL)
4218C
4219C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE,
4220C              DRAW A LINE FROM (IX1,IY1) TO (IX2,IY2).
4221C     NOTE--THE COORDINATES (IX1,IY1) AND (IX2,IY2) ARE IN
4222C           INTEGER PICTURE POINT VALUES.
4223C
4224C     WRITTEN BY--JAMES J. FILLIBEN
4225C                 STATISTICAL ENGINEERING DIVISION
4226C                 INFORMATION TECHNOLOGY LABORATORY
4227C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
4228C                 GAITHERSBURG, MD 20899-8980
4229C                 PHONE--301-975-2855
4230C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
4231C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
4232C     LANGUAGE--ANSI FORTRAN (1977)
4233C     VERSION NUMBER--83.6
4234C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
4235C     UPDATED         --JANUARY   1989. SUN (BY BILL ANDERSON)
4236C                                       DRIVER OBSOLETE
4237C     UPDATED         --JANUARY   1989. POSTSCRIPT (BY ALAN HECKERT)
4238C     UPDATED         --JANUARY   1989. CGM (BY ALAN HECKERT)
4239C     UPDATED         --JANUARY   1989. QMS QUIC (BY ALAN HECKERT)
4240C     UPDATED         --JANUARY   1989. CALCOMP (BY ALAN HECKERT)
4241C     UPDATED         --JANUARY   1989. ZETA (BY ALAN HECKERT)
4242C     UPDATED         --MARCH     1990. X11 (BY ALAN HECKERT)
4243C     UPDATED         --MAY       1991. BAD ARG IN 2 CALLS TO GRTRIN
4244C     UPDATED         --MAY       1991. RENUMBER TOP BRANCHES (JJF)
4245C     UPDATED         --MAY       1991. VGA/TURBOC DRIVER (JJF)
4246C                                       DRIVER OBSOLETE
4247C     UPDATED         --MAY       1991. X2 TO IX2 FOR SUN  (JJF)
4248C     UPDATED         --APRIL     1992. ZETA FIX
4249C     UPDATED         --JULY      1996. LAHEY DRIVER (ALAN HECKERT)
4250C                                       OLD CALCOMP STYLE
4251C                                       DRIVER OBSOLETE
4252C     UPDATED         --OCTOBER   1996. QUICKWIN DRIVER (ALAN)
4253C     UPDATED         --OCTOBER   1996. OPENGL DRIVER (ALAN)
4254C                                       USE BILL MITCHELLS OPENGL
4255C                                       BINDING FOR FORTRAN
4256C     UPDATED         --OCTOBER   1996. GKS (ALAN)
4257C                                       CODED, NOT TESTED
4258C     UPDATED         --OCTOBER   1996. BINARY CGM (ALAN)
4259C                                       PLACEHOLDER FOR NOW
4260C     UPDATED         --OCTOBER   1996. DISPLAY POSTSCRIPT (ALAN)
4261C                                       PLACEHOLDER FOR NOW
4262C     UPDATED         --OCTOBER   1997. LAHEY INTERACTOR (ALAN)
4263C     UPDATED         --DECEMBER  1997. UPDATE TO GENERAL CODED FOR
4264C                                       GUI.
4265C     UPDATED         --JULY      1998. LAHEY WINTERACTOR
4266C     UPDATED         --JUNE      2000. GD (FOR JPEG, PNG, WINDOWS BMP)
4267C     UPDATED         --JUNE      2000. MACINTOSH
4268C                                       PLACEHOLDER FOR NOW
4269C                     --MARCH     2002. CHANGE TO QUARTZ (NEW MAC
4270C                                       GRAPHICS LIBRARY)
4271C     UPDATED         --JUNE      2000. PC PRINTER
4272C                                       PLACEHOLDER FOR NOW
4273C                     --MARCH     2002. CHANGE TO GHOSTSCRIPT
4274C     UPDATED         --JUNE      2000. PC PRINTER
4275C     UPDATED         --JULY      2001. ADD JCOL ARGUMENT (COLOR INDEX
4276C                                       FOR GD DEVICE)
4277C     UPDATED         --MARCH     2002. LATEX (USING EEPIC)
4278C     UPDATED         --MARCH     2002. SVG (SCALABLE VECTOR GRAPHICS)
4279C     UPDATED         --MARCH     2005. SUPPORT FOR AQUATERM
4280C     UPDATED         --FEBRUARY  2006. IMPLEMENT LATEX DRIVER
4281C     UPDATED         --APRIL     2009. IMPLEMENT LIBPLOT DRIVER
4282C     UPDATED         --APRIL     2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
4283C                                       (THESE WERE NEVER ACTUALLY IMPLENENTED)
4284C     UPDATED         --SEPTEMBER 2015. FIX GREYSCALE COLOR FOR SVG
4285C     UPDATED         --OCTOBER   2016. ADD PRE-PROCESSOR DIRECTIVES
4286C     UPDATED         --OCTOBER   2016. ADD TEMPLATES FOR SEVERL FUTURE
4287C
4288C
4289C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
4290C
4291#ifdef HAVE_WININTERACTER
4292      USE WINTERACTER
4293#endif
4294#ifdef HAVE_INTERACTER
4295      USE INTERACTER
4296#endif
4297CQWIN USE DFLIB
4298#ifdef HAVE_QWIN
4299      USE IFQWIN
4300CCCCC LOGICAL MODESTATUS
4301      TYPE (WINDOWCONFIG)   DPSCREEN
4302      CHARACTER*4 QWSCRN
4303      COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
4304      TYPE (XYCOORD)   WXY
4305#endif
4306C
4307      INTEGER IGKSID
4308      INTEGER IGKSWK
4309      INTEGER IGKSTY
4310      COMMON/IGKS/IGKSID,IGKSWK,IGKSTY
4311C
4312      CHARACTER*130 ICSTR
4313      CHARACTER*4 ISUBN0
4314      CHARACTER*1 ICARAT
4315      CHARACTER*1 IQUOTE
4316      CHARACTER*2 ICJUNK
4317      INTEGER IXSUN(2)
4318      INTEGER IYSUN(2)
4319      REAL PXGKS(2)
4320      REAL PYGKS(2)
4321      DOUBLE PRECISION DPXGKS(2)
4322      DOUBLE PRECISION DPYGKS(2)
4323C
4324CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE
4325      PARAMETER(MAXCLR=89)
4326      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
4327C
4328C-----COMMON----------------------------------------------------------
4329C
4330      INCLUDE 'DPCOPA.INC'
4331      INCLUDE 'DPCOGR.INC'
4332      INCLUDE 'DPCONP.INC'
4333      INCLUDE 'DPCOBE.INC'
4334      INCLUDE 'DPCODV.INC'
4335      INCLUDE 'DPCOST.INC'
4336      INCLUDE 'DPCOF2.INC'
4337C
4338CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE
4339      INCLUDE 'DPCOCT.INC'
4340      INCLUDE 'DPCOP2.INC'
4341C
4342C-----START POINT-----------------------------------------------------
4343C
4344      ISUBN0='DRLI'
4345      IERRG4='NO'
4346C
4347      NCSTR=(-999)
4348C
4349      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRLI')THEN
4350        WRITE(ICOUT,999)
4351  999   FORMAT(1X)
4352        CALL DPWRST('XXX','BUG ')
4353        WRITE(ICOUT,51)
4354   51   FORMAT('***** AT THE BEGINNING OF GRDRLI--')
4355        CALL DPWRST('XXX','BUG ')
4356        WRITE(ICOUT,52)IX1,IY1,IX2,IY2
4357   52   FORMAT('IX1,IY1,  IX2,IY2 = ',2I8,4X,2I8)
4358        CALL DPWRST('XXX','BUG ')
4359        WRITE(ICOUT,54)PX1,PY1,PX2,PY2
4360   54   FORMAT('PX1,PY1,  PX2,PY2 = ',2G15.7,4X,2G15.7)
4361        CALL DPWRST('XXX','BUG ')
4362        WRITE(ICOUT,57)IFACTO,IGUNIT,IMANUF,IMODEL
4363   57   FORMAT('IFACTO,IGUNIT,IMANUF,IMODEL = ',2I8,2(2X,A4))
4364        CALL DPWRST('XXX','BUG ')
4365        WRITE(ICOUT,69)IBUGG4,ISUBG4,IERRG4
4366   69   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
4367        CALL DPWRST('XXX','BUG ')
4368      ENDIF
4369C
4370C               ****************************************
4371C               **  STEP XX--                         **
4372C               **  CHECK THAT THE INPUT COORDINATES  **
4373C               **  ARE WITHIN SCREEN LIMITS          **
4374C               ****************************************
4375C
4376      IX3=IX1
4377      IF(IX3.LE.0)IX3=0
4378      IF(IX3.GE.NUMHPP)IX3=NUMHPP-1
4379C
4380      IY3=IY1
4381      IF(IY3.LE.0)IY3=0
4382      IF(IY3.GE.NUMVPP)IY3=NUMVPP-1
4383C
4384      IX4=IX2
4385      IF(IX4.LE.0)IX4=0
4386      IF(IX4.GE.NUMHPP)IX4=NUMHPP-1
4387C
4388      IY4=IY2
4389      IF(IY4.LE.0)IY4=0
4390      IF(IY4.GE.NUMVPP)IY4=NUMVPP-1
4391C
4392C               ********************************************
4393C               **  STEP 1--                              **
4394C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
4395C               **  AND THE MODEL                         **
4396C               ********************************************
4397C
4398      IF(IMANUF.EQ.'QWIN')THEN
4399        GOTO4700
4400      ELSEIF(IMANUF.EQ.'POST')THEN
4401        GOTO8600
4402      ELSEIF(IMANUF.EQ.'X11 ')THEN
4403        GOTO9600
4404      ELSEIF(IMANUF.EQ.'AQUA')THEN
4405        GOTO13500
4406      ELSEIF(IMANUF.EQ.'GENE')THEN
4407        IF(IMODEL.EQ.'CODE')GOTO3200
4408        IF(IMODEL.EQ.'CGM')GOTO3300
4409        IF(IMODEL.EQ.'CGMB')GOTO3400
4410        GOTO3100
4411      ELSEIF(IMANUF.EQ.'SVG ')THEN
4412        GOTO16000
4413      ELSEIF(IMANUF.EQ.'GD  ')THEN
4414        GOTO12000
4415      ELSEIF(IMANUF.EQ.'LATE')THEN
4416        GOTO15000
4417      ELSEIF(IMANUF.EQ.'CAIR')THEN
4418        GOTO17000
4419      ELSEIF(IMANUF.EQ.'D3  ')THEN
4420        GOTO19000
4421      ELSEIF(IMANUF.EQ.'WMF ')THEN
4422        GOTO18000
4423      ELSEIF(IMANUF.EQ.'OPGL')THEN
4424        GOTO4800
4425      ELSEIF(IMANUF.EQ.'TEKT')THEN
4426        IF(IMODEL.EQ.'4027')GOTO1200
4427        GOTO1100
4428      ELSEIF(IMANUF.EQ.'HP')THEN
4429        IF(IMODEL.EQ.'7221')GOTO2100
4430        IF(IMODEL.EQ.'2622')GOTO2300
4431        IF(IMODEL.EQ.'2623')GOTO2300
4432        IF(IMODEL.EQ.'2627')GOTO2300
4433        IF(IMODEL.EQ.'2647')GOTO2300
4434        GOTO2200
4435      ELSEIF(IMANUF.EQ.'LIBP')THEN
4436        GOTO2600
4437      ELSEIF(IMANUF.EQ.'REGI')THEN
4438        GOTO8100
4439      ELSEIF(IMANUF.EQ.'GKS ')THEN
4440        GOTO11000
4441      ELSEIF(IMANUF.EQ.'LAHE')THEN
4442        IF(IMODEL.EQ.'INTE')GOTO4900
4443        IF(IMODEL.EQ.'WINT')GOTO4950
4444        GOTO4600
4445      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
4446        GOTO13000
4447      ELSEIF(IMANUF.EQ.'QUIC')THEN
4448        GOTO9100
4449      ELSEIF(IMANUF.EQ.'CALC')THEN
4450        GOTO4100
4451      ELSEIF(IMANUF.EQ.'ZETA')THEN
4452        GOTO5100
4453      ELSEIF(IMANUF.EQ.'TURB')THEN
4454        GOTO10000
4455      ELSEIF(IMANUF.EQ.'SUN ')THEN
4456        GOTO6600
4457      ENDIF
4458      GOTO9000
4459C
4460C               *********************************************
4461C               **  STEP 11--                              **
4462C               **  TREAT THE TEKTRONIX 40104 (ETC.) CASE  **
4463C               *********************************************
4464C
4465 1100 CONTINUE
4466      ICSTR(1:1)=IGSC
4467      NCSTR=1
4468      CALL TKTRPT(IX3,IY3,IFACTO,ICSTR,NCSTR,ISUBN0)
4469      CALL TKTRPT(IX4,IY4,IFACTO,ICSTR,NCSTR,ISUBN0)
4470      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4471      GOTO9000
4472C
4473C               *******************************
4474C               **  STEP 12--                **
4475C               **  TREAT THE 4027 CASE      **
4476C               **  (A COLOR RASTER DEVICE)  **
4477C               **  REFERENCE--XX            **
4478C               *******************************
4479C
4480 1200 CONTINUE
4481      ICSTR(1:5)='!VEC '
4482      NCSTR=5
4483      NCHTOT=8
4484      CALL GRTRIN(IX3,NCHTOT,ICSTR,NCSTR)
4485      CALL GRTRIN(IY3,NCHTOT,ICSTR,NCSTR)
4486      CALL GRTRIN(IX4,NCHTOT,ICSTR,NCSTR)
4487      CALL GRTRIN(IY4,NCHTOT,ICSTR,NCSTR)
4488      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4489      GOTO9000
4490C
4491C               ****************************************************
4492C               **  STEP 21--                                     **
4493C               **  TREAT THE HEWLETT-PACKARD 7221 CASE           **
4494C               **  (MULTI-COLOR PENPLOTTER)                      **
4495C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER          **
4496C               **             OPERATING AND PROGRAMMING MANUAL,  **
4497C               **             PAGE XX.                           **
4498C               ****************************************************
4499C
4500 2100 CONTINUE
4501      ICSTR(1:1)='p'
4502      NCSTR=1
4503      CALL HPTRPT(IX1,IY1,ICSTR,NCSTR,ISUBN0)
4504      NCSTR=NCSTR+1
4505      ICSTR(NCSTR:NCSTR)='}'
4506      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4507C
4508      ICSTR(1:1)='q'
4509      NCSTR=1
4510      CALL HPTRPT(IX2,IY2,ICSTR,NCSTR,ISUBN0)
4511      NCSTR=NCSTR+1
4512      ICSTR(NCSTR:NCSTR)='}'
4513      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4514C
4515      GOTO9000
4516C
4517C               ******************************************************
4518C               **  STEP 22--                                       **
4519C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
4520C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
4521C               **  (MULTI-COLOR PENPLOTTERS)                       **
4522C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
4523C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
4524C               **             OPERATING AND PROGRAMMING MANUAL,    **
4525C               **             PAGE XX, XXX.                        **
4526C               ******************************************************
4527C
4528 2200 CONTINUE
4529      ICSTR(1:5)='PU;PA'
4530      NCSTR=5
4531      NCHTOT=5
4532      CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
4533      ICSTR(11:11)=','
4534      NCSTR=11
4535      CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
4536      ICSTR(17:17)=';'
4537      NCSTR=17
4538      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4539C
4540      ICSTR(1:5)='PD;PA'
4541      NCSTR=5
4542      NCHTOT=5
4543      CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
4544      ICSTR(11:11)=','
4545      NCSTR=11
4546      CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR)
4547      ICSTR(17:17)=';'
4548      NCSTR=17
4549      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4550C
4551      GOTO9000
4552C
4553C               **********************************************************
4554C               **  STEP 23--                                           **
4555C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
4556C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
4557C               **  (MONOCHROME DISPLAY TERMINALS)                      **
4558C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
4559C               **             REFERENCE MANUAL,                        **
4560C               **             PAGE XX-X, XXX.                          **
4561C               **********************************************************
4562C
4563 2300 CONTINUE
4564      ICSTR(1:1)=IESCC
4565      ICSTR(2:4)='*pa'
4566      NCSTR=4
4567      NCHTOT=5
4568      CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
4569      ICSTR(10:10)=','
4570      NCSTR=10
4571      CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
4572      ICSTR(16:16)='Z'
4573      NCSTR=16
4574      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4575C
4576      ICSTR(1:1)=IESCC
4577      ICSTR(2:4)='*pb'
4578      NCSTR=4
4579      NCHTOT=5
4580      CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
4581      ICSTR(10:10)=','
4582      NCSTR=10
4583      CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR)
4584      ICSTR(16:16)='Z'
4585      NCSTR=16
4586      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4587      GOTO9000
4588C
4589C               ******************************************************
4590C               **  STEP 26--                                       **
4591C               **  TREAT THE UNIX LIBPLOT                  CASE    **
4592C               ******************************************************
4593C
4594 2600 CONTINUE
4595      DPXGKS(1)=DBLE(PX1)
4596      DPXGKS(2)=DBLE(PX2)
4597      DPYGKS(1)=DBLE(PY1)
4598      DPYGKS(2)=DBLE(PY2)
4599      NPTS=2
4600#ifdef HAVE_LIBPLOT
4601      CALL PLDRAW(DPXGKS,DPYGKS,NPTS)
4602#endif
4603      GOTO9000
4604C
4605C               ***************************************************
4606C               **  STEP 31--                                    **
4607C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE  **
4608C               ***************************************************
4609C
4610 3100 CONTINUE
4611      ICSTR(1:8)='MOVE TO '
4612      NCSTR=8
4613      NCHTOT=10
4614      NCHDEC=5
4615      CALL GRTRRE(PX1,NCHTOT,NCHDEC,ICSTR,NCSTR)
4616      ICSTR(19:20)='  '
4617      NCSTR=20
4618      CALL GRTRRE(PY1,NCHTOT,NCHDEC,ICSTR,NCSTR)
4619      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4620      ICSTR(1:8)='DRAW TO '
4621      NCSTR=8
4622      NCHTOT=10
4623      NCHDEC=5
4624      CALL GRTRRE(PX2,NCHTOT,NCHDEC,ICSTR,NCSTR)
4625      ICSTR(19:20)='  '
4626      NCSTR=20
4627      CALL GRTRRE(PY2,NCHTOT,NCHDEC,ICSTR,NCSTR)
4628      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4629      GOTO9000
4630C
4631C               ***************************************************************
4632C               **  STEP 32--                                                **
4633C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
4634C               ***************************************************************
4635C
4636C  DECEMBER 1997.  FOR GUI, CONVERT COORDINATES TO INTEGER (BY
4637C  MULTIPLYING BY 100).  DO NOT PRINT OUT SUCCESSIVE POINTS IF THEY
4638C  ARE IDENTICAL.
4639C
4640 3200 CONTINUE
4641      IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')GOTO3250
4642      ICSTR(1:5)='MOTO '
4643      NCSTR=5
4644      NCHTOT=10
4645      NCHDEC=5
4646      CALL GRTRRE(PX1,NCHTOT,NCHDEC,ICSTR,NCSTR)
4647      ICSTR(16:17)='  '
4648      NCSTR=17
4649      CALL GRTRRE(PY1,NCHTOT,NCHDEC,ICSTR,NCSTR)
4650      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4651      ICSTR(1:5)='DRTO '
4652      NCSTR=5
4653      NCHTOT=10
4654      NCHDEC=5
4655      CALL GRTRRE(PX2,NCHTOT,NCHDEC,ICSTR,NCSTR)
4656      ICSTR(16:17)='  '
4657      NCSTR=17
4658      CALL GRTRRE(PY2,NCHTOT,NCHDEC,ICSTR,NCSTR)
4659      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4660      GOTO3290
4661C
4662 3250 CONTINUE
4663      ICSTR(1:2)='M '
4664      NCSTR=2
4665      NCHTOT=IGENFA+3
4666      IPX1=INT(PX1*10.**IGENFA+0.5)
4667      IPY1=INT(PY1*10.**IGENFA+0.5)
4668      CALL GRTRIN(IPX1,NCHTOT,ICSTR,NCSTR)
4669      NCSTR=NCSTR+1
4670      ICSTR(NCSTR:NCSTR)='  '
4671      CALL GRTRIN(IPY1,NCHTOT,ICSTR,NCSTR)
4672      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4673      ICSTR(1:2)='D '
4674      NCSTR=2
4675      NCHTOT=IGENFA+3
4676      IPX2=INT(PX2*10.**IGENFA+0.5)
4677      IPY2=INT(PY2*10.**IGENFA+0.5)
4678      CALL GRTRIN(IPX2,NCHTOT,ICSTR,NCSTR)
4679      NCSTR=NCSTR+1
4680      ICSTR(NCSTR:NCSTR)='  '
4681      CALL GRTRIN(IPY2,NCHTOT,ICSTR,NCSTR)
4682      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4683C
4684 3290 CONTINUE
4685      GOTO9000
4686C
4687C               ***************************************************************
4688C               **  STEP 33--                                                **
4689C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
4690C               ***************************************************************
4691C
4692 3300 CONTINUE
4693      ICSTR(1:6)='LINE '
4694      NCSTR=6
4695      NCHTOT=10
4696      NCHDEC=5
4697      CALL GRTRSA(PX1,PY1,AX,AY,ISUBN0)
4698      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
4699      ICSTR(17:17)=','
4700      NCSTR=17
4701      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
4702      ICSTR(28:29)=', '
4703      NCSTR=29
4704      CALL GRTRSA(PX2,PY2,AX,AY,ISUBN0)
4705      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
4706      ICSTR(40:40)=','
4707      NCSTR=40
4708      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
4709      ICSTR(50:50)=';'
4710      NCSTR=50
4711      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4712      GOTO9000
4713C
4714C               ***************************************************
4715C               **  STEP 34--                                    **
4716C               **  TREAT THE CGM (BINARY)                 CASE  **
4717C               ***************************************************
4718C
4719 3400 CONTINUE
4720      GOTO9000
4721C
4722C               ******************************************************
4723C               **  STEP 41--                                       **
4724C               **  TREAT THE CALCOMP XXXXXX CASE                   **
4725C               **  WRITE OUT AN XXXXXXXXXX                         **
4726C               **  REFERENCE--USE CALCOMP LIBRARY ROUTINES         **
4727C               **             XX                                   **
4728C               **             PAGES XX AND XX                      **
4729C               ******************************************************
4730C
4731 4100 CONTINUE
4732#ifdef HAVE_CALCOMP
4733      CALL CALCPT(PX1,PY1,AX1,AY1,ISUBN0)
4734      IPEN=3
4735      CALL PLOT(AX1,AY1,IPEN)
4736      IPEN=2
4737      CALL CALCPT(PX2,PY2,AX1,AY1,ISUBN0)
4738      CALL PLOT(AX1,AY1,IPEN)
4739#endif
4740      GOTO9000
4741C
4742C               ******************************************************
4743C               **  STEP 46--                                       **
4744C               **  TREAT THE LAHEY   XXXXXX CASE                   **
4745C               **  REFERENCE--Programmer's Reference, Revision C   **
4746C               **             Lahey Computer Systems, January, 1992**
4747C               **             PAGES 51 THRU 65                     **
4748C               ******************************************************
4749C
4750 4600 CONTINUE
4751#ifdef HAVE_LAHEY_CALCOMP
4752      CALL CALCPT(PX1,PY1,AX1,AY1,ISUBN0)
4753      IPEN=3
4754      CALL PLOT(AX1,AY1,IPEN)
4755      IPEN=2
4756      CALL CALCPT(PX2,PY2,AX1,AY1,ISUBN0)
4757      CALL PLOT(AX1,AY1,IPEN)
4758#endif
4759      GOTO9000
4760C
4761C               ******************************************************
4762C               **  STEP 47--                                       **
4763C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
4764C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
4765C               ******************************************************
4766C
4767 4700 CONTINUE
4768      PYTEMP=PY1
4769      CALL GRTRSD(PX1,PYTEMP,IX1,IY1,ISUBN0)
4770#ifdef HAVE_QWIN
4771      CALL MOVETO(INT2(IX1),INT2(IY1),WXY)
4772      PYTEMP=PY2
4773      CALL GRTRSD(PX2,PYTEMP,IX2,IY2,ISUBN0)
4774      ISTATUS=LINETO(INT2(IX2),INT2(IY2))
4775#endif
4776      GOTO9000
4777C
4778C               ******************************************************
4779C               **  STEP 48--                                       **
4780C               **  TREAT THE OPEN-GL DRIVER                        **
4781C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
4782C               ******************************************************
4783C
4784 4800 CONTINUE
4785      PXGKS(1)=PX1
4786      PYGKS(1)=100.0 - PY1
4787      PXGKS(2)=PX2
4788      PYGKS(2)=100.0 - PY2
4789      NPTS=2
4790#ifdef HAVE_OPEN_GL
4791      CALL GLDRAW(PXGKS,PYGKS,NPTS)
4792#endif
4793      GOTO9000
4794C
4795C               ******************************************************
4796C               **  STEP 49--                                       **
4797C               **  TREAT THE LAHEY INTERACTOR CASE                 **
4798C               ******************************************************
4799C
4800 4900 CONTINUE
4801#ifdef HAVE_INTERACTER
4802      CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
4803      CALL IGrMoveTo(REAL(IX1),REAL(IY1))
4804      CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0)
4805      CALL IGrLineTo(REAL(IX2),REAL(IY2))
4806#endif
4807      GOTO9000
4808C
4809C               ******************************************************
4810C               **  STEP 49B-                                       **
4811C               **  TREAT THE LAHEY WINTERACTOR CASE                **
4812C               ******************************************************
4813C
4814 4950 CONTINUE
4815#ifdef HAVE_WINTERACTER
4816      CALL IGrMoveTo(PX1,PY1)
4817      CALL IGrLineTo(PX2,PY2)
4818#endif
4819      GOTO9000
4820C
4821C               ******************************************************
4822C               **  STEP 51--                                       **
4823C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
4824C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
4825C               **             MODELS 3600SX AND 3653SX             **
4826C               **             PAGES B-0 AND B-1                    **
4827C               **  USE CALCOMP LIBRARY ROUTINES                    **
4828C               ******************************************************
4829C
4830 5100 CONTINUE
4831#ifdef HAVE_ZETA
4832      CALL CALCPT(PX1,PY1,AX1,AY1,ISUBN0)
4833      IPEN=3
4834      CALL PLOT(AX1,AY1,IPEN)
4835      IPEN=2
4836CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT   APRIL 1992   ALAN
4837CCCCC IF(JPATT.GT.0)IPEN=13+JPATT
4838CCCCC IF(IPEN.NE.2 .AND. (IPEN.LT.14.OR.IPEN.GT.19))IPEN=2
4839      CALL CALCPT(PX2,PY2,AX1,AY1,ISUBN0)
4840      CALL PLOT(AX1,AY1,IPEN)
4841#endif
4842      GOTO9000
4843C
4844C               ******************************************************
4845C               **  STEP 66--                                       **
4846C               **  TREAT THE SUN CASE - WRITTEN BY BILL ANDERSON   **
4847C               ******************************************************
4848C
4849C
4850 6600 CONTINUE
4851      IXSUN(1) = IX1
4852      IXSUN(2) = IX2
4853      IYSUN(1) = IY1
4854      IYSUN(2) = IY2
4855#ifdef HAVE_SUN
4856      CALL cfpolyline(IXSUN,IYSUN,2)
4857#endif
4858      GOTO 9000
4859C
4860C               ******************************************************
4861C               **  STEP 81--                                       **
4862C               **  TREAT THE DEC  REGIS CASE                       **
4863C               **  TO XXX---                                       **
4864C               **  WRITE OUT AN XX                                 **
4865C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
4866C               **             PAGES 96 AND 145                     **
4867C               ******************************************************
4868C
4869 8100 CONTINUE
4870      ICSTR(1:2)='P['
4871      NCSTR=2
4872      NCHTOT=5
4873      CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
4874      CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
4875      ICSTR(8:8)=','
4876      NCSTR=8
4877      CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
4878      ICSTR(14:14)=']'
4879      NCSTR=14
4880      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4881      ICSTR(1:3)='V[]'
4882      NCSTR=3
4883      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4884C
4885      CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0)
4886      ICSTR(1:2)='V['
4887      NCSTR=2
4888      NCHTOT=5
4889      CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
4890      ICSTR(8:8)=','
4891      NCSTR=8
4892      CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR)
4893      ICSTR(14:14)=']'
4894      NCSTR=14
4895      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4896C
4897      GOTO9000
4898C
4899C               ******************************************************
4900C               **  STEP 86--                                       **
4901C               **  TREAT THE POSTSCRIPT CASE                       **
4902C               ******************************************************
4903C
4904 8600 CONTINUE
4905      ICSTR(1:8)='newpath '
4906      NCSTR=8
4907      CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
4908      NCHTOT=5
4909      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
4910      ICSTR(14:14)=' '
4911      NCSTR=14
4912      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
4913      ICSTR(20:27)=' moveto '
4914      NCSTR=27
4915      CALL GRTRSD(PX2,PY2,IX,IY,ISUBN0)
4916      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
4917      ICSTR(33:33)=' '
4918      NCSTR=33
4919      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
4920      ICSTR(39:52)=' lineto stroke'
4921      NCSTR=52
4922      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4923      GOTO9000
4924C
4925C               ******************************************************
4926C               **  STEP 91--                                       **
4927C               **  TREAT THE QUIC LANDSCAPE CASE                   **
4928C               **  <ICARAT>IGV       - ENABLE VECTOR GRAPHICS MODE **
4929C               **  <ICARAT>WTTTTTBBBBBLLLLLRRRRR - SET PAGE MARGINS**
4930C               **  NOTE: ENFORCE MARGIN WITH THE "OFFSET" AND NUMBER*
4931C               **        OF PICTURE POINTS.  WE ONLY WANT TO CLIP  **
4932C               **        AT THE MARGIN, NOT FORCE A PAGE ERASE.    **
4933C               **  <ICARAT>Tttttt    - SET Y ORGIN FROM TOP OF PAGE**
4934C               **  <ICARAT>Jjjjjj    - SET X ORGIN FROM LEFT       **
4935C               **  <ICARAT>PWnn      - SET PEN WIDTH (3 CLOSEST TO **
4936C               **                      0.1 DATAPLOT UNITS)         **
4937C               **  <ICARAT>UXXXXX:YYYYY - MOVE                     **
4938C               **  <ICARAT>DXXXXX:YYYYY - DRAW                     **
4939C               **  <ICARAT>IGE       - DISABLE VECTOR GRAPHICS MODE**
4940C               **  REFERENCE: QUIC PROGRAMMERS MANUAL - CHAPTER ON **
4941C               **             VECTOR GRAPHICS                      **
4942C               ******************************************************
4943C
4944 9100 CONTINUE
4945      CALL DPCONA(94,ICARAT)
4946      ICSTR(1:1)=ICARAT
4947      ICSTR(2:4)='IGV'
4948      ICSTR(5:5)=ICARAT
4949      ICSTR(6:6)='W'
4950C
4951      IF(IORNSW.EQ.'PORT')GOTO9110
4952CCCCC AXLEFT=IQUILM
4953CCCCC AXRGHT=11.*QUIPPI-IQUIRM
4954CCCCC AYTOP=IQUITM
4955CCCCC AYBOT=8.5*QUIPPI-IQUIBM
4956CCCCC AFACTH=11.*QUIPPI
4957CCCCC AFACTV=8.5*QUIPPI
4958      IX2=11000
4959      IY2=8500
4960      GOTO9120
4961C
4962 9110 CONTINUE
4963C
4964CCCCC AXLEFT=IQU2LM
4965CCCCC AXRGHT=8.5*QUIPPI-IQU2RM
4966CCCCC AYTOP=IQU2TM
4967CCCCC AYBOT=11.*QUIPPI-IQU2BM
4968CCCCC AFACTH=8.5*QUIPPI
4969CCCCC AFACTV=11.*QUIPPI
4970      IX2=8500
4971      IY2=11000
4972C
4973 9120 CONTINUE
4974C
4975CCCCC IX=INT(1000.*AXLEFT/QUIPPI+0.5)
4976CCCCC IX2=INT(1000.*AXRGHT/QUIPPI+0.5)
4977CCCCC IY=INT(1000.*AYTOP/QUIPPI+0.5)
4978CCCCC IY2=INT(1000.*AYBOT/QUIPPI+0.5)
4979      IX=0
4980      IY=0
4981      NCSTR=6
4982      NCHTOT=-5
4983      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
4984      CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR)
4985      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
4986      CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
4987      ICSTR(27:27)=ICARAT
4988      ICSTR(28:33)='T00000'
4989      ICSTR(34:34)=ICARAT
4990      ICSTR(35:40)='J00000'
4991      ICSTR(41:41)=ICARAT
4992      ICSTR(42:45)='PW03'
4993      NCSTR=45
4994      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
4995      ICSTR(1:1)=ICARAT
4996      ICSTR(2:2)='U'
4997C     NOTE: QUIC POSIOTIONS FROM TOP OF PAGE NOT THE BOTTOM, REVERSE Y
4998      PYTEMP=100.-PY1
4999      CALL QUICPT(PX1,PYTEMP,IX1,IY1,ISUBN0)
5000      NCSTR=2
5001      NCHTOT=-5
5002      CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
5003      ICSTR(8:8)=':'
5004      NCSTR=8
5005CCCCC THE FOLLOWING LINE WAS FIXED MAY 1991
5006CCCCC CALL GRTRIN(IY1,NCHTOT,ICSTR,ISUBNO)
5007      CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
5008      ICSTR(14:14)=ICARAT
5009      ICSTR(15:15)='D'
5010      NCSTR=15
5011      PYTEMP=100.-PY2
5012      CALL QUICPT(PX2,PYTEMP,IX1,IY1,ISUBN0)
5013      CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
5014      ICSTR(21:21)=ICARAT
5015      NCSTR=21
5016CCCCC THE FOLLOWING LINE WAS FIXED MAY 1991
5017CCCCC CALL GRTRIN(IY1,NCHTOT,ICSTR,ISUBN0)
5018      CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
5019      ICSTR(27:27)=ICARAT
5020      ICSTR(28:30)='IGE'
5021      NCSTR=30
5022      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5023      GOTO9000
5024C
5025C               ******************************************************
5026C               **  STEP 96--                                       **
5027C               **  TREAT THE X11        CASE                       **
5028C               ******************************************************
5029C
5030 9600 CONTINUE
5031#ifdef HAVE_X11
5032      IF(IX11OF.EQ.'OFF')GOTO9000
5033      NTEMP=2
5034      CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
5035      CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0)
5036      IXSUN(1)=IX1
5037      IYSUN(1)=IY1
5038CCCCC THE FOLLOWING LINE WAS CORRECTED MAY 24, 1991 (JJF)
5039CCCCC IXSUN(2)=X2
5040      IXSUN(2)=IX2
5041      IYSUN(2)=IY2
5042      CALL XDRAW(IXSUN,IYSUN,NTEMP)
5043#endif
5044      GOTO9000
5045C
5046C               *************************************************
5047C               **  STEP 100--                                 **
5048C               **  TREAT THE VGA VIA TURBO-C       CASE       **
5049C               *************************************************
5050C
505110000 CONTINUE
5052      IF(ITCST.EQ.'CLOS')GOTO9000
5053CTURB CALL TCDRLI(PX1,PY1,PX2,PY2)
5054      GOTO9000
5055C
5056C               ******************************************************
5057C               **  STEP 110--                                      **
5058C               **  TREAT THE GKS                DRIVER             **
5059C               ******************************************************
5060C
506111000 CONTINUE
5062      NP=2
5063      PXGKS(1) = PX1/100.0
5064      PXGKS(2) = PX2/100.0
5065      PYGKS(1) = PY1/100.0
5066      PYGKS(2) = PY2/100.0
5067#ifdef HAVE_GKS
5068      CALL GPL(NP, PXGKS, PYGKS)
5069#endif
5070      GOTO9000
5071C
5072C               ******************************************************
5073C               **  STEP 120--                                      **
5074C               **  TREAT THE GD                     DRIVER         **
5075C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
5076C               **  1) JPEG                                         **
5077C               **  2) PNG                                          **
5078C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
5079C               ******************************************************
5080C
508112000 CONTINUE
5082      NTEMP=2
5083      CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
5084      CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0)
5085      JPATT=1
5086CCCCC JULY 2001.  PASS JCOL AS ARGUMENT RATHER THAN HARD CODING IT.
5087CCCCC JCOL=1
5088#ifdef HAVE_GD
5089      CALL GDDRAW(IX1,IY1,IX2,IY2,JCOL,JPATT)
5090#endif
5091      GOTO9000
5092C
5093C               ******************************************************
5094C               **  STEP 130--                                      **
5095C               **  TREAT THE ABSOFT                 DRIVER         **
5096C               ******************************************************
5097C
509813000 CONTINUE
5099      GOTO9000
5100C
5101C               ******************************************************
5102C               **  STEP 135--                                      **
5103C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
5104C               ******************************************************
5105C
510613500 CONTINUE
5107      CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
5108      PXGKS(1)=REAL(IX1)
5109      PYGKS(1)=REAL(IY1)
5110COLD  CALL aqtMoveTo(AX1,AY1)
5111      CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0)
5112      PXGKS(2)=REAL(IX2)
5113      PYGKS(2)=REAL(IY2)
5114      NPTS=2
5115COLD  CALL aqtAddLineTo(AX2,AY2)
5116      ICAP=1
5117      IF(IAQUCS.EQ.'ROUN')ICAP=2
5118      IF(IAQUCS.EQ.'SQUA')ICAP=3
5119#ifdef HAVE_AQUA
5120      CALL aqdraw(PXGKS,PYGKS,NPTS,ICAP)
5121#endif
5122      GOTO9000
5123C
5124C               ******************************************************
5125C               **  STEP 150--                                      **
5126C               **  TREAT THE LATEX (EEPIC)                  DRIVER **
5127C               ******************************************************
5128C
512915000 CONTINUE
5130      ICSTR(1:1)=IBASLC
5131      ICSTR(2:13)='drawline[ 0]'
5132      NCSTR=13
5133C
5134      CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
5135      CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0)
5136      NCHTOT=5
5137      NCSTR=NCSTR+1
5138      ICSTR(NCSTR:NCSTR)='('
5139      CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
5140      NCSTR=NCSTR+1
5141      ICSTR(NCSTR:NCSTR)=','
5142      CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
5143      NCSTR=NCSTR+1
5144      ICSTR(NCSTR:NCSTR)=')'
5145      NCSTR=NCSTR+1
5146      ICSTR(NCSTR:NCSTR)='('
5147      CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
5148      NCSTR=NCSTR+1
5149      ICSTR(NCSTR:NCSTR)=','
5150      CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR)
5151      NCSTR=NCSTR+1
5152      ICSTR(NCSTR:NCSTR)=')'
5153C
5154      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5155      GOTO9000
5156C
5157C               ******************************************************
5158C               **  STEP 160--                                      **
5159C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
5160C               ******************************************************
5161C
516216000 CONTINUE
5163C
5164      CALL DPCONA(34,IQUOTE)
5165C
5166      ISVGLN=ISVGLN+1
5167      ICSTR(1:9)='   <g id='
5168      ICSTR(10:10)=IQUOTE
5169      NCSTR=10
5170      IF(ISVGLN.LE.9)THEN
5171        NCHTOT=1
5172      ELSEIF(ISVGLN.LE.99)THEN
5173        NCHTOT=2
5174      ELSEIF(ISVGLN.LE.999)THEN
5175        NCHTOT=3
5176      ELSEIF(ISVGLN.LE.9999)THEN
5177        NCHTOT=4
5178      ELSEIF(ISVGLN.LE.99999)THEN
5179        NCHTOT=5
5180      ELSE
5181        NCHTOT=6
5182      ENDIF
5183      CALL GRTRIN(ISVGLN,NCHTOT,ICSTR,NCSTR)
5184      NCSTR=NCSTR+1
5185      ICSTR(NCSTR:NCSTR)=IQUOTE
5186      NCSTR=NCSTR+1
5187      ICSTR(NCSTR:NCSTR)='>'
5188      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5189C
5190      ICSTR(1:8)='   <line'
5191      ICSTR(9:9)=IQUOTE
5192      NCSTR=-9
5193C
5194      IF(ISVGSS(1:3).EQ.'EXT')THEN
5195        NCSTR=12
5196        ICSTR(1:NCSTR)='      class='
5197        NCSTR=NCSTR+1
5198        ICSTR(NCSTR:NCSTR)=IQUOTE
5199        NCSTR=NCSTR+1
5200        ICSTR(NCSTR:NCSTR+6)='narrow-'
5201        NCSTR=NCSTR+7
5202        ICSTR(NCSTR:NCSTR+4)='solid'
5203        NCSTR=NCSTR+5
5204        ICSTR(NCSTR:NCSTR)=IQUOTE
5205        NCSTR=-NCSTR
5206        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5207C
5208        CALL GRTRCO('FORE',ISVGFC,JCOL2)
5209        IF(JCOL2.NE.JCOL)THEN
5210          ICSTR(1:12)='      style='
5211          ICSTR(13:13)=IQUOTE
5212          NCSTR=-13
5213          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5214          ICSTR(1:21)='             stroke:#'
5215          NCSTR=21
5216          NCHTOT=2
5217          JTEMP=JCOL
5218          IF(JTEMP.LE.0)THEN
5219C
5220C           DATAPLOT CURRENTLY ALLOWS GREYSCALE VALUES IN
5221C           THE RANGE 0 TO 100.  FOR SPECIFYING COLOR TO SVG,
5222C           SCALE THAT 0 TO 100 VALUE TO A 0 TO 255 VALUE.
5223C
5224            AVAL=(255./100.)*REAL(ABS(JTEMP))
5225            IF(AVAL.LE.0.0)AVAL=0.0
5226            IF(AVAL.GE.255.0)AVAL=255.0
5227            JRED=INT(AVAL+0.5)
5228            JBLUE=JRED
5229            JGREEN=JRED
5230          ELSE
5231            IF(JTEMP.LT.1 .OR. JTEMP.GT.MAXCLR)JTEMP=1
5232            JRED=IRED(JTEMP)
5233            JGREEN=IGREEN(JTEMP)
5234            JBLUE=IBLUE(JTEMP)
5235          ENDIF
5236          CALL DPCONX(JRED,ICJUNK)
5237          NCSTR=NCSTR+1
5238          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
5239          NCSTR=NCSTR+1
5240          CALL DPCONX(JGREEN,ICJUNK)
5241          NCSTR=NCSTR+1
5242          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
5243          NCSTR=NCSTR+1
5244          CALL DPCONX(JBLUE,ICJUNK)
5245          NCSTR=NCSTR+1
5246          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
5247          NCSTR=NCSTR+2
5248          ICSTR(NCSTR:NCSTR)=';'
5249          NCSTR=-NCSTR
5250          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5251          ICSTR(1:13)='             '
5252          ICSTR(14:14)=IQUOTE
5253          NCSTR=-14
5254          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5255        ENDIF
5256C
5257      ELSE
5258        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5259        ICSTR(1:15)='         style='
5260        ICSTR(16:16)=IQUOTE
5261        NCSTR=-16
5262        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5263C
5264        ICSTR(1:28)='             stroke-width:1;'
5265        NCSTR=-26
5266        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5267C
5268        IF(ISVGCA.EQ.'ROUN')THEN
5269          NCSTR=35
5270          ICSTR(1:NCSTR)='             stroke-linecap: round;'
5271          NCSTR=-NCSTR
5272          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5273        ELSEIF(ISVGCA.EQ.'SQUA')THEN
5274          NCSTR=36
5275          ICSTR(1:NCSTR)='             stroke-linecap: square;'
5276          NCSTR=-NCSTR
5277          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5278        ELSEIF(ISVGCA.EQ.'BUTT')THEN
5279          NCSTR=34
5280          ICSTR(1:NCSTR)='             stroke-linecap: butt;'
5281          NCSTR=-NCSTR
5282          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5283        ELSE
5284          CONTINUE
5285        ENDIF
5286C
5287        IF(ISVGJS.EQ.'ROUN')THEN
5288          NCSTR=36
5289          ICSTR(1:NCSTR)='             stroke-linejoin: round;'
5290          NCSTR=-NCSTR
5291          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5292        ELSEIF(ISVGJS.EQ.'BEVE')THEN
5293          NCSTR=36
5294          ICSTR(1:NCSTR)='             stroke-linejoin: bevel;'
5295          NCSTR=-NCSTR
5296          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5297        ELSEIF(ISVGJS.EQ.'MITE')THEN
5298          NCSTR=36
5299          ICSTR(1:NCSTR)='             stroke-linejoin: miter;'
5300          NCSTR=-NCSTR
5301          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5302        ELSE
5303          CONTINUE
5304        ENDIF
5305C
5306        ICSTR(1:21)='             stroke:#'
5307        NCSTR=21
5308        NCHTOT=2
5309        JTEMP=JCOL
5310        IF(JTEMP.LE.0)THEN
5311C
5312C         DATAPLOT CURRENTLY ALLOWS GREYSCALE VALUES IN
5313C         THE RANGE 0 TO 100.  FOR SPECIFYING COLOR TO SVG,
5314C         SCALE THAT 0 TO 100 VALUE TO A 0 TO 255 VALUE.
5315C
5316          AVAL=(255./100.)*REAL(ABS(JTEMP))
5317          IF(AVAL.LE.0.0)AVAL=0.0
5318          IF(AVAL.GE.255.0)AVAL=255.0
5319          JRED=INT(AVAL+0.5)
5320          JBLUE=JRED
5321          JGREEN=JRED
5322        ELSE
5323          IF(JTEMP.LT.1 .OR. JTEMP.GT.MAXCLR)JTEMP=1
5324          JRED=IRED(JTEMP)
5325          JGREEN=IGREEN(JTEMP)
5326          JBLUE=IBLUE(JTEMP)
5327        ENDIF
5328        CALL DPCONX(JRED,ICJUNK)
5329        NCSTR=NCSTR+1
5330        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
5331        NCSTR=NCSTR+1
5332        CALL DPCONX(JGREEN,ICJUNK)
5333        NCSTR=NCSTR+1
5334        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
5335        NCSTR=NCSTR+1
5336        CALL DPCONX(JBLUE,ICJUNK)
5337        NCSTR=NCSTR+1
5338        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
5339        NCSTR=NCSTR+2
5340        ICSTR(NCSTR:NCSTR)=';'
5341        NCSTR=-NCSTR
5342        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5343      ENDIF
5344C
5345      NCHTOT=5
5346      ICSTR(1:9)='      x1='
5347      ICSTR(10:10)=IQUOTE
5348      NCSTR=10
5349      CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
5350      CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0)
5351      CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
5352      NCSTR=NCSTR+1
5353      ICSTR(NCSTR:NCSTR)=IQUOTE
5354      NCSTR=NCSTR+1
5355      ICSTR(NCSTR:NCSTR+3)=' y1='
5356      NCSTR=NCSTR+4
5357      ICSTR(NCSTR:NCSTR)=IQUOTE
5358      CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
5359      NCSTR=NCSTR+1
5360      ICSTR(NCSTR:NCSTR)=IQUOTE
5361      NCSTR=NCSTR+1
5362      ICSTR(NCSTR:NCSTR+3)=' x2='
5363      NCSTR=NCSTR+4
5364      ICSTR(NCSTR:NCSTR)=IQUOTE
5365      CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
5366      NCSTR=NCSTR+1
5367      ICSTR(NCSTR:NCSTR)=IQUOTE
5368      NCSTR=NCSTR+1
5369      ICSTR(NCSTR:NCSTR+3)=' y2='
5370      NCSTR=NCSTR+4
5371      ICSTR(NCSTR:NCSTR)=IQUOTE
5372      CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR)
5373      NCSTR=NCSTR+1
5374      ICSTR(NCSTR:NCSTR)=IQUOTE
5375C
5376      NCSTR=NCSTR+1
5377      ICSTR(NCSTR:NCSTR+1)='/>'
5378      NCSTR=-(NCSTR+1)
5379      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5380C
5381      ICSTR(1:4)='</g>'
5382      NCSTR=-4
5383      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5384C
5385      GOTO9000
5386C
5387C               ******************************************************
5388C               **  STEP 170--                                      **
5389C               **  TREAT THE CAIRO                          DRIVER **
5390C               ******************************************************
5391C
539217000 CONTINUE
5393#ifdef HAVE_CAIRO
5394C
5395C     SET CAP AND JOIN STYLES
5396C
5397      IF(ICAICA.EQ.'BUTT')THEN
5398        ICAP=2
5399      ELSEIF(ICAICA.EQ.'ROUN')THEN
5400        ICAP=3
5401      ELSEIF(ICAICA.EQ.'SQUA')THEN
5402        ICAP=4
5403      ELSE
5404        ICAP=1
5405      ENDIF
5406      IF(ICAIJS.EQ.'MITE')THEN
5407        IJOIN=2
5408      ELSEIF(ICAIJS.EQ.'ROUN')THEN
5409        IJOIN=3
5410      ELSEIF(ICAICA.EQ.'BEVE')THEN
5411        IJOIN=4
5412      ELSE
5413        IJOIN=1
5414      ENDIF
5415C
5416      IVAL2=1
5417      IF(IGUNIT.EQ.IPL1NU)IVAL2=2
5418      IF(IGUNIT.EQ.IPL2NU)IVAL2=3
5419C
5420      AX1=PX1
5421      AY1=PY1
5422      AX2=PX2
5423      AY2=PY2
5424      CALL GRTRSD(AX1,AY1,IX1,IY1,ISUBN0)
5425      CALL GRTRSD(AX2,AY2,IX2,IY2,ISUBN0)
5426      JPATT=1
5427C
5428      PXGKS(1)=AX1
5429      PXGKS(2)=AX2
5430      PYGKS(1)=AY1
5431      PYGKS(2)=AY2
5432      PTHIC2=0.1
5433      NP=2
5434      CALL CADRAW(IVAL2,PXGKS,PYGKS,NP,ICAP,IJOIN,JPATT,PTHIC2)
5435#endif
5436      GOTO9000
5437C
5438C               ******************************************************
5439C               **  STEP 180--                                      **
5440C               **  TREAT THE WMF                            DRIVER **
5441C               ******************************************************
5442C
544318000 CONTINUE
5444      GOTO9000
5445C
5446C               ******************************************************
5447C               **  STEP 190--                                      **
5448C               **  TREAT THE D3                             DRIVER **
5449C               ******************************************************
5450C
545119000 CONTINUE
5452      GOTO9000
5453C
5454C               *****************
5455C               **  STEP 90--  **
5456C               **  EXIT       **
5457C               *****************
5458C
5459 9000 CONTINUE
5460      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRLI')THEN
5461        WRITE(ICOUT,999)
5462        CALL DPWRST('XXX','BUG ')
5463        WRITE(ICOUT,9011)
5464 9011   FORMAT('***** AT THE END       OF GRDRLI--')
5465        CALL DPWRST('XXX','BUG ')
5466        WRITE(ICOUT,9013)IX3,IY3,IX4,IY4
5467 9013   FORMAT('IX3,IY3,  IX4,IY4 = ',2I8,4X,2I8)
5468        CALL DPWRST('XXX','BUG ')
5469        WRITE(ICOUT,9023)NCSTR,IERRG
5470 9023   FORMAT('NCSTR,IERRG = ',I8,2X,A4)
5471        CALL DPWRST('XXX','BUG ')
5472        IF(NCSTR.GE.1)THEN
5473          DO9025I=1,NCSTR
5474            CALL DPCOAN(ICSTR(I:I),IASCNE)
5475            WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
5476 9026       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
5477            CALL DPWRST('XXX','BUG ')
5478 9025     CONTINUE
5479        ENDIF
5480      ENDIF
5481C
5482      RETURN
5483      END
5484      SUBROUTINE GRDRPH(PX,PY,NP,
5485     1                  IFIG,IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,
5486     1                  IFILL,ICOL,
5487     1                  JPATT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILL,JCOL,
5488     1                  PTHICK,JTHICK,PTHIC2,
5489     1                  PHEIGH,PWIDTH,PVEGAP,PHOGAP,
5490     1                  PHEIG2,PWIDT2,PVEGA2,PHOGA2,
5491     1                  JHEIG2,JWIDT2,JVEGA2,JHOGA2,
5492     1                  ISYMBL,ISPAC)
5493C
5494C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE, DRAW THE HORIZONTAL
5495C              POLYMARKER WHOSE COORDINATES ARE GIVEN IN (PX(.),PY(.)).
5496C     NOTE--THE COORDINATES IN (PX(.),PY(.)) ARE IN
5497C           STANDARDIZED (0.0 TO 100.0) UNITS.
5498C     NOTE--THERE ARE NP SUCH COORDINATE PAIRS.
5499C
5500C     WRITTEN BY--JAMES J. FILLIBEN
5501C                 STATISTICAL ENGINEERING DIVISION
5502C                 INFORMATION TECHNOLOGY LABORATORY
5503C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
5504C                 GAITHERSBURG, MD 20899-8980
5505C                 PHONE--301-975-2855
5506C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
5507C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
5508C     LANGUAGE--ANSI FORTRAN (1977)
5509C     VERSION NUMBER--83.6
5510C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
5511C     UPDATED         --JANUARY  1989.  SUN (BY BILL ANDERSON)
5512C                                       DRIVER OBSOLETE
5513C     UPDATED         --JANUARY  1989.  POSTSCRIPT (BY ALAN HECKERT)
5514C     UPDATED         --JANUARY  1989.  CGM (BY ALAN HECKERT)
5515C     UPDATED         --JANUARY  1989.  QMS QUIC (BY ALAN HECKERT)
5516C     UPDATED         --JANUARY  1989.  CALCOMP (BY ALAN HECKERT)
5517C     UPDATED         --JANUARY  1989.  ZETA (BY ALAN HECKERT)
5518C     UPDATED         --APRIL    1989.  SOFT-CODE BACKSLASH FOR UNIX
5519C     UPDATED         --MARCH    1990.  X11 (BY ALAN HECKERT)
5520C     UPDATED         --JULY     1990.  PACK HP-2622 OUTPUT
5521C     UPDATED         --MARCH    1991.  PACK REGIS OUTPUT
5522C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
5523C                                       DRIVER OBSOLETE
5524C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
5525C     UPDATED         --MAY      1991.  FIX POSTSCRIPT CHAR. INDICES
5526C     UPDATED         --OCTOBER  1991.  POSTSCRIPT FONTS (ALAN)
5527C     UPDATED         --MAY      1992.  ADJUST JUSTIFICATION
5528C                                       FOR WINDOW (ALAN)
5529C     UPDATED         --SEPTEMBER 1994. FIX TURBO-C SECTION
5530C                                 BAD C-SIDE CHARACTER PLOTS (NO X'S)
5531C     UPDATED         --SEPTEMBER 1994. FIX TURBO-C SECTION
5532C                                       BAD C-SIDE MULTIPLOTS (SCALING)
5533C     UPDATED         --JANUARY   1995. FIX CHAR CENTERING FOR TURBO-C
5534C     UPDATED         --SEPTEMBER 1995. FIX TURBO-C SECTION
5535C                          BAD C-SIDE CHARACTER PLOTS (NO X'S) (AGAIN)
5536C     UPDATED         --SEPTEMBER 1995. ADD "PIXEL" CHARACTER TO DRAW
5537C                                       A SINGLE POINT.  NOT IMPLEMENTED
5538C                                       FOR ALL DEVICES ON INITIAL PASS.
5539C     UPDATED         --JULY     1996 . LAHEY DRIVER (ALAN HECKERT)
5540C                                       OLD CALCOMP STYLE
5541C                                       DRIVER OBSOLETE
5542C     UPDATED         --JULY     1996. LOWER CASE "BLAN" (BUG FOR CASE
5543C                                      ASIS)
5544C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
5545C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
5546C                                      USE BILL MITCHELLS OPENGL
5547C                                      BINDING FOR FORTRAN
5548C     UPDATED         --OCTOBER  1996. GKS (ALAN)
5549C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
5550C                                      PLACEHOLDER FOR NOW
5551C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
5552C                                      PLACEHOLDER FOR NOW
5553C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
5554C     UPDATED         --DECEMBER 1997. GENERAL CODED FOR GUI
5555C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
5556C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
5557C     UPDATED         --JUNE     2000. MACINTOSH
5558C                                      PLACEHOLDER FOR NOW
5559C                     --MARCH    2002. CHANGE TO QUARTZ (NEW MAC GRAPHICS
5560C                                      LIBRARY)
5561C     UPDATED         --JUNE     2000. PC PRINTER
5562C                                      PLACEHOLDER FOR NOW
5563C                     --MARCH    2002. CHANGE TO GHOSTSCRIPT
5564C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
5565C                                      PLACEHOLDER FOR NOW
5566C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
5567C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
5568C     UPDATED         --FEBRUARY 2006. IMPLEMENT LATEK DRIVER
5569C     UPDATED         --APRIL    2009. IMPLEMENT LIBPLOT DRIVER
5570C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
5571C                                      (THESE WERE NEVER ACTUALLY IMPLENENTED)
5572C     UPDATED         --FEBRUARY  2012 "<" AND ">" IN STRINGS FOR SVG
5573C     UPDATED         --JULY      2015 ISSUE WITH TEXT FOR SVG DRIVER
5574C                                      WHEN USING THE CHROME BROWSER
5575C     UPDATED         --SEPTEMBER 2015 FIX GREYSCALE COLOR FOR SVG
5576C     UPDATED         --NOVEMBER  2015 FOR SVG, CHECK FOR "&" IN TEXT
5577C     UPDATED         --OCTOBER   2016. ADD PRE-PROCESSOR DIRECTIVES
5578C     UPDATED         --OCTOBER   2016. ADD TEMPLATES FOR SEVERL FUTURE
5579C
5580C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
5581C
5582#ifdef HAVE_WININTERACTER
5583      USE WINTERACTER
5584#endif
5585#ifdef HAVE_INTERACTER
5586      USE INTERACTER
5587#endif
5588CQWIN USE DFLIB
5589#ifdef HAVE_QWIN
5590      USE IFQWIN
5591CCCCC LOGICAL MODESTATUS
5592      TYPE (WINDOWCONFIG)   DPSCREEN
5593      CHARACTER*4 QWSCRN
5594      COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWFN
5595      TYPE (XYCOORD)   WXY
5596#endif
5597C
5598      INTEGER IGKSID
5599      INTEGER IGKSWK
5600      INTEGER IGKSTY
5601      COMMON/IGKS/IGKSID,IGKSWK,IGKSTY
5602C
5603      CHARACTER*4 IFONT
5604      CHARACTER*4 ICASE
5605      CHARACTER*4 IJUST
5606      CHARACTER*4 IDIR
5607      CHARACTER*4 IFILL
5608      CHARACTER*4 ICOL
5609      CHARACTER*4 IFIG
5610      CHARACTER*4 IPATT
5611C
5612      CHARACTER*24 ISYMBL
5613      CHARACTER*4 ISPAC
5614C
5615      CHARACTER*4 ICTEXT(16)
5616C
5617      CHARACTER*4 IC4
5618      CHARACTER*1 IC
5619      CHARACTER*1 IC1
5620      CHARACTER*1 IC2
5621      CHARACTER*1 ICARAT
5622      CHARACTER*1 IQUOTE
5623      CHARACTER*2 ICJUNK
5624C
5625      DIMENSION PX(*)
5626      DIMENSION PY(*)
5627C
5628      CHARACTER*130 ICSTR
5629      CHARACTER*4 ISUBN0
5630C  FOLLOWING 2 LINES ADDED MARCH, 1990 FOR X11
5631      INTEGER STRING(20)
5632      INTEGER IADE(80)
5633CCCCC FOLLOWING 5 LINES FOR LAHEY COMPILER ADDED JULY 1996.
5634#ifdef HAVE_LAHEY_CALCOMP
5635      CHARACTER*40 CLAHEY
5636      REAL RLAHEY(7)
5637      INTEGER ILAHEY(9)
5638      DIMENSION IHOLL(10)
5639#endif
5640      CHARACTER*4 IJUSTH
5641      CHARACTER*4 IJUSTV
5642C
5643CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE
5644      PARAMETER(MAXCLR=89)
5645      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
5646C
5647C-----COMMON----------------------------------------------------------
5648C
5649      INCLUDE 'DPCOPA.INC'
5650      INCLUDE 'DPCOGR.INC'
5651      INCLUDE 'DPCONP.INC'
5652      INCLUDE 'DPCOBE.INC'
5653      INCLUDE 'DPCOST.INC'
5654      INCLUDE 'DPCODV.INC'
5655      INCLUDE 'DPCOF2.INC'
5656CCCCC THE FOLLOWING COMMON BLOCK WAS ADDED MAY 1992.
5657      COMMON /RWIND/
5658     1PWXMIN,PWXMAX,PWYMIN,PWYMAX,PWZMIN,PWZMAX,
5659     1WWXMIN,WWXMAX,WWYMIN,WWYMAX,WWZMIN,WWZMAX
5660C
5661CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE
5662      INCLUDE 'DPCOCT.INC'
5663      INCLUDE 'DPCOP2.INC'
5664C
5665C-----START POINT-----------------------------------------------------
5666C
5667      ISUBN0='DRPH'
5668      IERRG4='NO'
5669      IC4='-999'
5670      IC='-'
5671      IC1='-'
5672      IC2='-'
5673C
5674      NCSTR=(-999)
5675      K=(-999)
5676      NCTEP2=(-999)
5677C
5678      IFONTH=0
5679      IFONTV=0
5680      IF(IJUST.EQ.'LEFT')IFONTH=0
5681      IF(IJUST.EQ.'CENT')IFONTH=1
5682      IF(IJUST.EQ.'RIGH')IFONTH=2
5683      IF(IJUST.EQ.'LJUS')IFONTH=0
5684      IF(IJUST.EQ.'CJUS')IFONTH=1
5685      IF(IJUST.EQ.'RJUS')IFONTH=2
5686      IF(IJUST.EQ.'LEBO')IFONTH=0
5687      IF(IJUST.EQ.'CEBO')IFONTH=1
5688      IF(IJUST.EQ.'RIBO')IFONTH=2
5689      IF(IJUST.EQ.'LECE')IFONTH=0
5690      IF(IJUST.EQ.'CECE')IFONTH=1
5691      IF(IJUST.EQ.'RICE')IFONTH=2
5692      IF(IJUST.EQ.'LETO')IFONTH=0
5693      IF(IJUST.EQ.'CETO')IFONTH=1
5694      IF(IJUST.EQ.'RITO')IFONTH=2
5695      IF(IJUST.EQ.'LEFT')IFONTV=1
5696      IF(IJUST.EQ.'CENT')IFONTV=1
5697      IF(IJUST.EQ.'RIGH')IFONTV=1
5698      IF(IJUST.EQ.'LJUS')IFONTV=1
5699      IF(IJUST.EQ.'CJUS')IFONTV=1
5700      IF(IJUST.EQ.'RJUS')IFONTV=1
5701      IF(IJUST.EQ.'LEBO')IFONTV=1
5702      IF(IJUST.EQ.'CEBO')IFONTV=1
5703      IF(IJUST.EQ.'RIBO')IFONTV=1
5704      IF(IJUST.EQ.'LECE')IFONTV=0
5705      IF(IJUST.EQ.'CECE')IFONTV=0
5706      IF(IJUST.EQ.'RICE')IFONTV=0
5707      IF(IJUST.EQ.'LETO')IFONTV=2
5708      IF(IJUST.EQ.'CETO')IFONTV=2
5709      IF(IJUST.EQ.'RITO')IFONTV=2
5710C
5711      PXDEL=(-999.0)
5712      PYDEL=(-999.0)
5713      PXINC=(-999.0)
5714      PYINC=(-999.0)
5715C
5716      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRPH')THEN
5717        WRITE(ICOUT,999)
5718  999   FORMAT(1X)
5719        CALL DPWRST('XXX','BUG ')
5720        WRITE(ICOUT,51)
5721   51   FORMAT('***** AT THE BEGINNING OF GRDRPH--')
5722        CALL DPWRST('XXX','BUG ')
5723        WRITE(ICOUT,52)NP,IGUNIT,JPATT,JFONT,JCASE,JJUST
5724   52   FORMAT('NP,IGUNIT,JPATT,JFONT,JCASE,JJUST = ',6I8)
5725        CALL DPWRST('XXX','BUG ')
5726        WRITE(ICOUT,53)IMANUF,IFIG,IPATT,IFONT,ICASE,IJUST,IFILL
5727   53   FORMAT('IMANUF,IFIG,IPATT,IFONT,ICASE,IJUST,IFILL = ',
5728     1         6(A4,2X),A4)
5729        CALL DPWRST('XXX','BUG ')
5730        DO55I=1,NP
5731          WRITE(ICOUT,56)PX(I),PY(I)
5732   56     FORMAT('PX(I),PY(I) = ',2G15.7)
5733          CALL DPWRST('XXX','BUG ')
5734   55   CONTINUE
5735        WRITE(ICOUT,63)IDIR,ICOL,ANGLE,ANGLE2,JDIR,JCOL
5736   63   FORMAT('IDIR,ICOL,ANGLE,ANGLE2,JDIR,JCOL = ',
5737     1         2(A4,2X),2G15.7,2I8)
5738        CALL DPWRST('XXX','BUG ')
5739        WRITE(ICOUT,66)PTHICK,JTHICK,PTHIC2
5740   66   FORMAT('PTHICK,JTHICK,PTHIC2 = ',G15.7,I8,G15.7)
5741        CALL DPWRST('XXX','BUG ')
5742        WRITE(ICOUT,67)PHEIGH,PWIDTH,PVEGAP,PHOGAP
5743   67   FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4G15.7)
5744        CALL DPWRST('XXX','BUG ')
5745        WRITE(ICOUT,68)PHEIG2,PWIDT2,PVEGA2,PHOGA2
5746   68   FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4G15.7)
5747        CALL DPWRST('XXX','BUG ')
5748        WRITE(ICOUT,69)JFILL,JHOGA2,JVEGA2,JHEIG2,JWIDT2
5749   69   FORMAT('JFILL,JHOGA2,JVEGA2,JHEIG2,JWIDT2 = ',5I5)
5750        CALL DPWRST('XXX','BUG ')
5751        WRITE(ICOUT,71)ISYMBL,ISPAC
5752   71   FORMAT('ISYMBL,ISPAC = ',A24,2X,A4)
5753        CALL DPWRST('XXX','BUG ')
5754        WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
5755   79   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
5756        CALL DPWRST('XXX','BUG ')
5757      ENDIF
5758C
5759C               **************************************
5760C               **  STEP XX--                       **
5761C               **  TREAT THE BLANK CHARACTER CASE  **
5762C               **************************************
5763C
5764      IF(ISYMBL.EQ.'    ')GOTO9000
5765      IF(ISYMBL.EQ.'BLAN')GOTO9000
5766      IF(ISYMBL.EQ.'NONE')GOTO9000
5767      IF(ISYMBL.EQ.'SPAC')GOTO9000
5768      IF(ISYMBL.EQ.'BL')GOTO9000
5769      IF(ISYMBL.EQ.'NO')GOTO9000
5770      IF(ISYMBL.EQ.'SP')GOTO9000
5771CCCCC JULY 1996.  IF CHARACTER CASE ASIS SET, THESE WILL BE IN LOWER
5772CCCCC CASE.  REPEAT FOR LOWER CASE.
5773      IF(ISYMBL.EQ.'blan')GOTO9000
5774      IF(ISYMBL.EQ.'none')GOTO9000
5775      IF(ISYMBL.EQ.'spac')GOTO9000
5776      IF(ISYMBL.EQ.'bl')GOTO9000
5777      IF(ISYMBL.EQ.'no')GOTO9000
5778      IF(ISYMBL.EQ.'sp')GOTO9000
5779C
5780C               ********************************************************
5781C               **  STEP 0--                                          **
5782C               **  COMPUTE THE INCREMENT TO ALLOW A NEW START POINT  **
5783C               **  FOR THE MARKER.  THIS IMNCREMENT DEPENDS ON THE   **
5784C               **  JUSTIFICATION FOR THE MARKER.                     **
5785C               ********************************************************
5786C
5787CCCCC ADD FOLLOWING 2 LINES  JULY 1996.
5788      IJUSTH='CENT'
5789      IJUSTV='CENT'
5790      IF(IJUST.EQ.'LEFT')GOTO910
5791      IF(IJUST.EQ.'CENT')GOTO920
5792      IF(IJUST.EQ.'RIGH')GOTO930
5793C
5794      IF(IJUST.EQ.'LJUS')GOTO910
5795      IF(IJUST.EQ.'CJUS')GOTO920
5796      IF(IJUST.EQ.'RJUS')GOTO930
5797C
5798      IF(IJUST.EQ.'LEBO')GOTO910
5799      IF(IJUST.EQ.'CEBO')GOTO920
5800      IF(IJUST.EQ.'RIBO')GOTO930
5801C
5802      IF(IJUST.EQ.'LECE')GOTO940
5803      IF(IJUST.EQ.'CECE')GOTO950
5804      IF(IJUST.EQ.'RICE')GOTO960
5805C
5806      IF(IJUST.EQ.'LETO')GOTO970
5807      IF(IJUST.EQ.'CETO')GOTO980
5808      IF(IJUST.EQ.'RITO')GOTO990
5809C
5810      GOTO910
5811C
5812  910 CONTINUE
5813      PXINC=0.0
5814      PYINC=0.0
5815      IJUSTH='LEFT'
5816      IJUSTV='BOTT'
5817      GOTO995
5818C
5819  920 CONTINUE
5820      PXINC=PWIDT2/2.0
5821      PYINC=0.0
5822      IJUSTH='CENT'
5823      IJUSTV='BOTT'
5824      GOTO995
5825C
5826  930 CONTINUE
5827      PXINC=PWIDT2
5828      PYINC=0.0
5829      IJUSTH='RIGH'
5830      IJUSTV='BOTT'
5831      GOTO990
5832C
5833  940 CONTINUE
5834      PXINC=0.0
5835      PYINC=PHEIG2/2.0
5836      IJUSTH='LEFT'
5837      IJUSTV='CENT'
5838      GOTO995
5839C
5840  950 CONTINUE
5841      PXINC=PWIDT2/2.0
5842      PYINC=PHEIG2/2.0
5843      IJUSTH='CENT'
5844      IJUSTV='CENT'
5845      GOTO995
5846C
5847  960 CONTINUE
5848      PXINC=PWIDT2
5849      PYINC=PHEIG2/2.0
5850      IJUSTH='RIGH'
5851      IJUSTV='CENT'
5852      GOTO990
5853C
5854  970 CONTINUE
5855      PXINC=0.0
5856      PYINC=PHEIG2
5857      IJUSTH='LEFT'
5858      IJUSTV='TOP '
5859      GOTO995
5860C
5861  980 CONTINUE
5862      PXINC=PWIDT2/2.0
5863      PYINC=PHEIG2
5864      IJUSTH='CENT'
5865      IJUSTV='TOP '
5866      GOTO995
5867C
5868  990 CONTINUE
5869      PXINC=PWIDT2
5870      PYINC=PHEIG2
5871      IJUSTH='RIGH'
5872      IJUSTV='TOP '
5873      GOTO995
5874C
5875  995 CONTINUE
5876CCCCC FOLLOWING 2 LINES ADDED MAY 1992.
5877      PXINC=PXINC*(100.0/(PWXMAX-PWXMIN))
5878      PYINC=PYINC*(100.0/(PWYMAX-PWYMIN))
5879C
5880C               ********************************************
5881C               **  STEP 1--                              **
5882C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
5883C               **  AND THE MODEL                         **
5884C               ********************************************
5885C
5886      IF(IMANUF.EQ.'QWIN')THEN
5887        GOTO4700
5888      ELSEIF(IMANUF.EQ.'POST')THEN
5889        GOTO8600
5890      ELSEIF(IMANUF.EQ.'X11 ')THEN
5891        GOTO9600
5892      ELSEIF(IMANUF.EQ.'AQUA')THEN
5893        GOTO13500
5894      ELSEIF(IMANUF.EQ.'GENE')THEN
5895        IF(IMODEL.EQ.'CODE')GOTO3200
5896        IF(IMODEL.EQ.'CGM')GOTO3300
5897        IF(IMODEL.EQ.'CGMB')GOTO3400
5898        GOTO3100
5899      ELSEIF(IMANUF.EQ.'SVG ')THEN
5900        GOTO16000
5901      ELSEIF(IMANUF.EQ.'GD  ')THEN
5902        GOTO12000
5903      ELSEIF(IMANUF.EQ.'LATE')THEN
5904        GOTO15000
5905      ELSEIF(IMANUF.EQ.'CAIR')THEN
5906        GOTO17000
5907      ELSEIF(IMANUF.EQ.'D3  ')THEN
5908        GOTO19000
5909      ELSEIF(IMANUF.EQ.'WMF ')THEN
5910        GOTO18000
5911      ELSEIF(IMANUF.EQ.'OPGL')THEN
5912        GOTO4800
5913      ELSEIF(IMANUF.EQ.'TEKT')THEN
5914        GOTO1100
5915      ELSEIF(IMANUF.EQ.'HP')THEN
5916        IF(IMODEL.EQ.'7221')GOTO2100
5917        IF(IMODEL.EQ.'2622')GOTO2300
5918        IF(IMODEL.EQ.'2623')GOTO2300
5919        IF(IMODEL.EQ.'2627')GOTO2300
5920        IF(IMODEL.EQ.'2647')GOTO2300
5921        GOTO2200
5922      ELSEIF(IMANUF.EQ.'LIBP')THEN
5923        GOTO2600
5924      ELSEIF(IMANUF.EQ.'REGI')THEN
5925        GOTO8100
5926      ELSEIF(IMANUF.EQ.'GKS ')THEN
5927        GOTO11000
5928      ELSEIF(IMANUF.EQ.'LAHE')THEN
5929        IF(IMODEL.EQ.'INTE')GOTO4900
5930        IF(IMODEL.EQ.'WINT')GOTO4950
5931        GOTO4600
5932      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
5933        GOTO13000
5934      ELSEIF(IMANUF.EQ.'QUIC')THEN
5935        GOTO9100
5936      ELSEIF(IMANUF.EQ.'CALC')THEN
5937        GOTO4100
5938      ELSEIF(IMANUF.EQ.'ZETA')THEN
5939        GOTO5100
5940      ELSEIF(IMANUF.EQ.'TURB')THEN
5941        GOTO10000
5942      ELSEIF(IMANUF.EQ.'SUN ')THEN
5943        GOTO6600
5944      ENDIF
5945      GOTO9000
5946C
5947C               ******************************************************
5948C               **  STEP 11--                                       **
5949C               **  TREAT THE TEKTRONIX 4014 (ETC.) CASE            **
5950C               ******************************************************
5951C
5952CCCCC SEPTEMBER 1995.  ADD "PIXEL" CAPABILITY.
5953 1100 CONTINUE
5954      IFACTO=4
5955CCCCC IF(NUMHPP.GE.4000)IFACTO=1
5956CCCCC FOLLOWING LINE MODIFIED MARCH, 1990 (ALLOW PORTRAIT, SQUARE ORIEN)
5957      IF(NUMVPP.GE.3000)IFACTO=1
5958C
5959      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
5960        NCOL=INT(PHEIGH)
5961        IF(NCOL.LT.1)NCOL=1
5962        IF(IFONTH.EQ.0)THEN
5963          IXINC=0
5964        ELSEIF(IFONTH.EQ.1)THEN
5965          IXINC=NCOL/2
5966        ELSE
5967          IXINC=NCOL
5968        ENDIF
5969        IF(IFONTV.EQ.0)THEN
5970          IYINC=0
5971        ELSEIF(IFONTV.EQ.1)THEN
5972          IYINC=NCOL/2
5973        ELSE
5974          IYINC=NCOL
5975        ENDIF
5976        DO1170I=1,NP
5977          PX1=PX(I)
5978          PY1=PY(I)
5979          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
5980          DO1175IROW=IX,IX+NCOL-1
5981            DO1178ICOLZ=IY,IY+NCOL-1
5982              ICSTR(1:1)=IGSC
5983              ICSTR(2:2)=IFSC
5984              NCSTR=2
5985              IXTEMP=IROW-IXINC
5986              IYTEMP=ICOLZ-IYINC
5987              CALL TKTRPT(IXTEMP,IYTEMP,IFACTO,ICSTR,NCSTR,ISUBN0)
5988              CALL TKTRPT(IXTEMP,IYTEMP,IFACTO,ICSTR,NCSTR,ISUBN0)
5989              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
5990 1178       CONTINUE
5991 1175     CONTINUE
5992 1170   CONTINUE
5993      ELSE
5994        DO1110I=1,NP
5995          ICSTR(1:1)=IGSC
5996          NCSTR=1
5997          PX1P=PX(I)-PXINC
5998          PY1P=PY(I)-PYINC
5999          CALL GRTRSD(PX1P,PY1P,IX1P,IY1P,ISUBN0)
6000          CALL TKTRPT(IX1P,IY1P,IFACTO,ICSTR,NCSTR,ISUBN0)
6001          NCSTR=NCSTR+1
6002          ICSTR(NCSTR:NCSTR)=IUSC
6003          NCSTR=NCSTR+1
6004          ICSTR(NCSTR:NCSTR)=ISYMBL(1:1)
6005          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6006 1110   CONTINUE
6007      ENDIF
6008C
6009      GOTO9000
6010C
6011C               ******************************************************
6012C               **  STEP 21--                                       **
6013C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
6014C               **  (MULTI-COLOR PENPLOTTER)                        **
6015C               **  TO DRAW A HORIZONTAL POLYMARKER--               **
6016C               **  USE THE p (= MOVE) INSTRUCTION                  **
6017C               **  AND PACKED BINARY COORDINATES,                  **
6018C               **  AND THE ~' (= INVOKE LABEL MODE) INSTRUCTION    **
6019C               **  AND THE DESIRED TEXT STRING,                    **
6020C               **  AND ETX TO DENOTE THE END OF TEXT STRING,       **
6021C               **  (WITH TRAILING RIGHT CURLY BRACKET WHICH IS THE **
6022C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
6023C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
6024C               **             OPERATING AND PROGRAMMING MANUAL,    **
6025C               **             PAGE 80-85, 253-254.                 **
6026C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
6027C               **             OPERATING AND PROGRAMMING MANUAL,    **
6028C               **             PAGE 111 AND 112.                    **
6029C               ******************************************************
6030C
6031 2100 CONTINUE
6032C
6033C
6034      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
6035        WRITE(ICOUT,2162)
6036 2162   FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ',
6037     1         'THE HP-7221 DEVICE.')
6038        CALL DPWRST('XXX','BUG ')
6039      ELSE
6040        DO2110I=1,NP
6041          ICSTR(1:1)='p'
6042          NCSTR=1
6043          PX1P=PX(I)-PXINC
6044          PY1P=PY(I)-PYINC
6045          CALL GRTRSD(PX1P,PY1P,IX1P,IY1P,ISUBN0)
6046          CALL HPTRPT(IX1P,IY1P,ICSTR,NCSTR,ISUBN0)
6047          NCSTR=NCSTR+1
6048          ICSTR(NCSTR:NCSTR)='}'
6049          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6050          ICSTR(1:2)='~'''
6051          ICSTR(3:3)=ISYMBL(1:1)
6052          ICSTR(4:4)=IETXC
6053          ICSTR(5:5)='}'
6054          NCSTR=5
6055          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6056 2110   CONTINUE
6057      ENDIF
6058C
6059      GOTO9000
6060C
6061C               ******************************************************
6062C               **  STEP 22--                                       **
6063C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
6064C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
6065C               **  (MULTI-COLOR PENPLOTTERS)                       **
6066C               **  TO DRAW A HORIZONTAL POLYMARKER--               **
6067C               **  USE THE PU (= PEN UP) INSTRUCTION               **
6068C               **  AND THE PA (= PLOT ABSOLUTE) INSTRUCTION        **
6069C               **  ALONG WITH INTEGER COORDINATES,                 **
6070C               **  AND THE LB (= LABEL) INSTRUCTION                **
6071C               **  AND THE DESIRED TEXT STRING,                    **
6072C               **  AND ETX TO DENOTE THE END OF TEXT STRING,       **
6073C               **  (WITH   TRAILING SEMI-COLONS WHICH ARE THE      **
6074C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
6075C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
6076C               **             OPERATING AND PROGRAMMING MANUAL,    **
6077C               **             PAGE 62, 143.                        **
6078C               **             PAGE 65-67, 143.                     **
6079C               **             PAGE 75, 141.                        **
6080C               ******************************************************
6081C
6082CCCCC SEPTEMBER 1995.  ADD SUPPORT FOR PIXEL CAPABILITY
6083 2200 CONTINUE
6084      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
6085        NCOL=INT(PHEIGH)
6086        IF(NCOL.LT.1)NCOL=1
6087        IF(IFONTH.EQ.0)THEN
6088          IXINC=0
6089        ELSEIF(IFONTH.EQ.1)THEN
6090          IXINC=NCOL/2
6091        ELSE
6092          IXINC=NCOL
6093        ENDIF
6094        IF(IFONTV.EQ.0)THEN
6095          IYINC=0
6096        ELSEIF(IFONTV.EQ.1)THEN
6097          IYINC=NCOL/2
6098        ELSE
6099          IYINC=NCOL
6100        ENDIF
6101        ICSTR(1:14)='1 setlinewidth'
6102        NCSTR=14
6103        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6104        DO2270I=1,NP
6105          PX1=PX(I)
6106          PY1=PY(I)
6107          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
6108          IX=IX-IXINC
6109          IY=IY-IYINC
6110          IX2=IX+NCOL-1
6111          IY2=IY+NCOL-1
6112          DO2280ICOLZ=IY,IY2
6113C
6114            ICSTR(1:5)='PU;PA'
6115            NCSTR=5
6116            NCHTOT=5
6117            CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
6118            ICSTR(11:11)=','
6119            NCSTR=11
6120            CALL GRTRIN(ICOLZ,NCHTOT,ICSTR,NCSTR)
6121            ICSTR(17:17)=';'
6122            NCSTR=17
6123            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6124C
6125            ICSTR(1:5)='PD;PA'
6126            NCSTR=5
6127            NCHTOT=5
6128            CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
6129            ICSTR(11:11)=','
6130            NCSTR=11
6131            CALL GRTRIN(ICOLZ,NCHTOT,ICSTR,NCSTR)
6132            ICSTR(17:17)=';'
6133            NCSTR=17
6134            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6135 2280     CONTINUE
6136 2270   CONTINUE
6137      ELSE
6138        NCTEXT=1
6139        ICTEXT(NCTEXT)=ISYMBL(1:4)
6140        NCTEP1=NCTEXT+1
6141        NCTEP2=NCTEXT+2
6142        ICTEXT(NCTEP1)=IETXC
6143        ICTEXT(NCTEP2)=';'
6144C
6145        DO2210I=1,NP
6146C
6147          PX1P=PX(I)-PXINC
6148          PY1P=PY(I)-PYINC
6149          CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
6150          ICSTR(1:5)='PU;PA'
6151          NCSTR=5
6152          NCHTOT=5
6153          CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
6154          ICSTR(11:11)=','
6155          NCSTR=11
6156          CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
6157          ICSTR(17:17)=';'
6158          NCSTR=17
6159          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6160C
6161          ICSTR(1:2)='LB'
6162          NCSTR=2
6163          DO2212J=1,NCTEP2
6164            K=J+NCSTR
6165            ICSTR(K:K)=ICTEXT(J)
6166 2212     CONTINUE
6167          NCSTR=K
6168          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6169C
6170 2210   CONTINUE
6171      ENDIF
6172      GOTO9000
6173C
6174C               **********************************************************
6175C               **  STEP 23--                                           **
6176C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
6177C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
6178C               **  (MONOCHROME DISPLAY TERMINALS)                      **
6179C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
6180C               **             REFERENCE MANUAL,                        **
6181C               **             PAGE 10-12, 10-13, 10-21.
6182C               **********************************************************
6183C
6184C  MODIFIED JULY, 1990 TO PACK ONTO 1 LINE.
6185C
6186CCCCC SEPTEMBER 1995.  ADD PIXEL CAPABILITY.
6187C
6188 2300 CONTINUE
6189C
6190      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
6191        NCOL=INT(PHEIGH)
6192        IF(NCOL.LT.1)NCOL=1
6193        IF(IFONTH.EQ.0)THEN
6194          IXINC=0
6195        ELSEIF(IFONTH.EQ.1)THEN
6196          IXINC=NCOL/2
6197        ELSE
6198          IXINC=NCOL
6199        ENDIF
6200        IF(IFONTV.EQ.0)THEN
6201          IYINC=0
6202        ELSEIF(IFONTV.EQ.1)THEN
6203          IYINC=NCOL/2
6204        ELSE
6205          IYINC=NCOL
6206        ENDIF
6207        ICSTR(1:14)='1 setlinewidth'
6208        NCSTR=14
6209        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6210        DO2370I=1,NP
6211          PX1=PX(I)
6212          PY1=PY(I)
6213          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
6214          IX=IX-IXINC
6215          IY=IY-IYINC
6216          IX2=IX+NCOL-1
6217          IY2=IY+NCOL-1
6218          DO2380ICOLZ=IY,IY2
6219C
6220            ICSTR(1:1)=IESCC
6221            ICSTR(2:4)='*pa'
6222            NCSTR=4
6223            NCHTOT=5
6224            CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
6225            ICSTR(10:10)=','
6226            NCSTR=10
6227            CALL GRTRIN(ICOLZ,NCHTOT,ICSTR,NCSTR)
6228            ICSTR(16:16)='Z'
6229            NCSTR=16
6230            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6231C
6232            ICSTR(1:1)=IESCC
6233            ICSTR(2:4)='*pb'
6234            NCSTR=4
6235            NCHTOT=5
6236            CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
6237            ICSTR(10:10)=','
6238            NCSTR=10
6239            CALL GRTRIN(ICOLZ,NCHTOT,ICSTR,NCSTR)
6240            ICSTR(16:16)='Z'
6241            NCSTR=16
6242            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6243C
6244 2380     CONTINUE
6245 2370   CONTINUE
6246      ELSE
6247        NCTEXT=1
6248        ICTEXT(NCTEXT)=ISYMBL(1:4)
6249        NCTEP1=NCTEXT+1
6250        ICTEXT(NCTEP1)=ICRC
6251        DO2310I=1,NP
6252          PX1P=PX(I)-PXINC
6253          PY1P=PY(I)-PYINC
6254          CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
6255          ICSTR(1:1)=IESCC
6256          ICSTR(2:4)='*pa'
6257          NCSTR=4
6258          NCHTOT=5
6259          CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
6260          ICSTR(10:10)=','
6261          NCSTR=10
6262          CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
6263          ICSTR(16:16)='Z'
6264          NCSTR=16
6265          ICSTR(17:17)=IESCC
6266          ICSTR(18:19)='*l'
6267          NCSTR=19
6268          DO2312J=1,NCTEP1
6269            K=J+NCSTR
6270            ICSTR(K:K)=ICTEXT(J)
6271 2312     CONTINUE
6272          NCSTR=K
6273          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6274 2310   CONTINUE
6275      ENDIF
6276C
6277      GOTO9000
6278C
6279C               **********************************************************
6280C               **  STEP 26--                                           **
6281C               **  TREAT THE UNIX LIBPLOT            CASE              **
6282C               **********************************************************
6283C
6284 2600 CONTINUE
6285      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
6286        NCOL=INT(PHEIGH)
6287        IF(NCOL.LT.1)NCOL=1
6288        IF(IFONTH.EQ.0)THEN
6289          IXINC=0
6290        ELSEIF(IFONTH.EQ.1)THEN
6291          IXINC=NCOL/2
6292        ELSE
6293          IXINC=NCOL
6294        ENDIF
6295        IF(IFONTV.EQ.0)THEN
6296          IYINC=0
6297        ELSEIF(IFONTV.EQ.1)THEN
6298          IYINC=NCOL/2
6299        ELSE
6300          IYINC=NCOL
6301        ENDIF
6302        DO2670I=1,NP
6303          PX1=PX(I)
6304          PY1=PY(I)
6305          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
6306          IX=IX-IXINC
6307          IY=IY-IYINC
6308          DO2675IROW=IX,IX+NCOL-1
6309            DO2678ICOLZ=IY,IY-NCOL+1,-1
6310              PX1=IROW-IXINC
6311              PY1=ICOLZ+IYINC
6312#ifdef HAVE_LIBPLOT
6313              CALL PLPOIN(DBLE(PX1),DBLE(PY1))
6314#endif
6315 2678       CONTINUE
6316 2675     CONTINUE
6317 2670   CONTINUE
6318      ELSE
6319        ILAST=80
6320        DO2610I=80,1,-1
6321          ILAST=I
6322          IF(ILPLFN(I:I).NE.' ')GOTO2619
6323 2610   CONTINUE
6324 2619   CONTINUE
6325        DO2620I=1,ILAST
6326          CALL DPCOAN(ILPLFN(I:I),IJUNK)
6327          IADE(I)=IJUNK
6328 2620   CONTINUE
6329        IADE(ILAST+1)=0
6330C
6331        CALL DPCOAN(ISYMBL(1:1),IJUNK)
6332        STRING(1)=IJUNK
6333        STRING(2)=0
6334        IERR=0
6335C
6336        DO2650I=1,NP
6337          PX1=PX(I)
6338          PY1=PY(I)
6339#ifdef HAVE_LIBPLOT
6340          CALL PLTXTH(IADE,STRING,DBLE(PX1),DBLE(PY1),IFONTH,IFONTV,
6341     1                DBLE(PHEIG2),IERR)
6342#endif
6343 2650   CONTINUE
6344      ENDIF
6345      GOTO9000
6346C
6347C               ******************************************************
6348C               **  STEP 31--                                       **
6349C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
6350C               ******************************************************
6351C
6352 3100 CONTINUE
6353C
6354      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
6355        WRITE(ICOUT,3102)
6356 3102   FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ',
6357     1         'THE GENERAL DEVICE.')
6358        CALL DPWRST('XXX','BUG ')
6359      ELSE
6360        NCTEXT=1
6361        ICTEXT(NCTEXT)=ISYMBL(1:4)
6362        IF(IJUSSW.EQ.'ON')THEN
6363          DO3160I=1,NP
6364            PX1P=PX(I)
6365            PY1P=PY(I)
6366            CALL GRTRSA(PX1P,PY1P,AX1,AY1,ISUBN0)
6367            PX1P=AX1
6368            PY1P=AY1
6369            ICSTR(1:8)='MOVE TO '
6370            NCSTR=8
6371            NCHTOT=10
6372            NCHDEC=5
6373            CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
6374            ICSTR(19:20)='  '
6375            NCSTR=20
6376            CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
6377            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6378            ICSTR(1:11)='WRITE TEXT '
6379            NCSTR=11
6380            DO3162J=1,NCTEXT
6381              K=J+NCSTR
6382              ICSTR(K:K)=ICTEXT(J)
6383 3162       CONTINUE
6384            NCSTR=K
6385            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6386 3160     CONTINUE
6387        ELSE
6388          DO3110I=1,NP
6389            PX1P=PX(I)-PXINC
6390            PY1P=PY(I)-PYINC
6391            CALL GRTRSA(PX1P,PY1P,AX1,AY1,ISUBN0)
6392            PX1P=AX1
6393            PY1P=AY1
6394            ICSTR(1:8)='MOVE TO '
6395            NCSTR=8
6396            NCHTOT=10
6397            NCHDEC=5
6398            CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
6399            ICSTR(19:20)='  '
6400            NCSTR=20
6401            CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
6402            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6403            ICSTR(1:11)='WRITE TEXT '
6404            NCSTR=11
6405            DO3112J=1,NCTEXT
6406              K=J+NCSTR
6407              ICSTR(K:K)=ICTEXT(J)
6408 3112       CONTINUE
6409            NCSTR=K
6410            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6411 3110     CONTINUE
6412        ENDIF
6413      ENDIF
6414C
6415      GOTO9000
6416C
6417C               ***************************************************************
6418C               **  STEP 32--                                                **
6419C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
6420C               ***************************************************************
6421C
6422 3200 CONTINUE
6423      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
6424        WRITE(ICOUT,3262)
6425 3262   FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ',
6426     1         'THE GENERAL DEVICE.')
6427        CALL DPWRST('XXX','BUG ')
6428      ELSE
6429        NCTEXT=1
6430        ICTEXT(NCTEXT)=ISYMBL(1:4)
6431        IF(IJUSSW.EQ.'ON')THEN
6432          IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')THEN
6433            DO3280I=1,NP
6434              CALL GRTRSA(PX(I),PY(I),AX1,AY1,ISUBN0)
6435              IPXTMP=INT(AX1*10.**IGENFA+0.5)
6436              IPYTMP=INT(AY1*10.**IGENFA+0.5)
6437              ICSTR(1:2)='M '
6438              NCSTR=2
6439              NCHTOT=IGENFA+3
6440              CALL GRTRIN(IPXTMP,NCHTOT,ICSTR,NCSTR)
6441              NCSTR=NCSTR+1
6442              ICSTR(NCSTR:NCSTR)='  '
6443              CALL GRTRIN(IPYTMP,NCHTOT,ICSTR,NCSTR)
6444              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6445              ICSTR(1:5)='WRTE '
6446              NCSTR=5
6447              DO3282J=1,NCTEXT
6448                K=J+NCSTR
6449                ICSTR(K:K)=ICTEXT(J)
6450 3282         CONTINUE
6451              NCSTR=K
6452              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6453 3280       CONTINUE
6454          ELSE
6455            DO3260I=1,NP
6456              PX1P=PX(I)
6457              PY1P=PY(I)
6458              CALL GRTRSA(PX1P,PY1P,AX1,AY1,ISUBN0)
6459              PX1P=AX1
6460              PY1P=AY1
6461              ICSTR(1:5)='MOTO '
6462              NCSTR=5
6463              NCHTOT=10
6464              NCHDEC=5
6465              CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
6466              ICSTR(16:17)='  '
6467              NCSTR=17
6468              CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
6469              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6470              ICSTR(1:5)='WRTE '
6471              NCSTR=5
6472              DO3252J=1,NCTEXT
6473                K=J+NCSTR
6474                ICSTR(K:K)=ICTEXT(J)
6475 3252         CONTINUE
6476              NCSTR=K
6477              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6478 3260       CONTINUE
6479          ENDIF
6480        ELSE
6481          IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')THEN
6482            DO3240I=1,NP
6483              PX1P=PX(I)-PXINC
6484              PY1P=PY(I)-PYINC
6485              CALL GRTRSA(PX1P,PY1P,AX1,AY1,ISUBN0)
6486              IPXTMP=INT(AX1*10.**IGENFA+0.5)
6487              IPYTMP=INT(AY1*10.**IGENFA+0.5)
6488              ICSTR(1:2)='M '
6489              NCSTR=2
6490              NCHTOT=IGENFA+3
6491              CALL GRTRIN(IPXTMP,NCHTOT,ICSTR,NCSTR)
6492              NCSTR=NCSTR+1
6493              ICSTR(NCSTR:NCSTR)='  '
6494              CALL GRTRIN(IPYTMP,NCHTOT,ICSTR,NCSTR)
6495              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6496              ICSTR(1:5)='WRTE '
6497              NCSTR=5
6498              DO3242J=1,NCTEXT
6499                K=J+NCSTR
6500                ICSTR(K:K)=ICTEXT(J)
6501 3242         CONTINUE
6502              NCSTR=K
6503              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6504 3240       CONTINUE
6505          ELSE
6506            DO3210I=1,NP
6507              PX1P=PX(I)-PXINC
6508              PY1P=PY(I)-PYINC
6509              CALL GRTRSA(PX1P,PY1P,AX1,AY1,ISUBN0)
6510              PX1P=AX1
6511              PY1P=AY1
6512              ICSTR(1:5)='MOTO '
6513              NCSTR=5
6514              NCHTOT=10
6515              NCHDEC=5
6516              CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
6517              ICSTR(16:17)='  '
6518              NCSTR=17
6519              CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
6520              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6521              ICSTR(1:5)='WRTE '
6522              NCSTR=5
6523              DO3212J=1,NCTEXT
6524                K=J+NCSTR
6525                ICSTR(K:K)=ICTEXT(J)
6526 3212         CONTINUE
6527              NCSTR=K
6528              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6529 3210       CONTINUE
6530          ENDIF
6531        ENDIF
6532      ENDIF
6533C
6534      GOTO9000
6535C
6536C               ***************************************************************
6537C               **  STEP 33--                                                **
6538C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
6539C               **  TEXT (XCOOR,YCOOR) FINAL "<SYMBOL>";                     **
6540C               ***************************************************************
6541C
6542 3300 CONTINUE
6543C
6544      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
6545        WRITE(ICOUT,3362)
6546 3362   FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ',
6547     1         'THE CGM DEVICE.')
6548        CALL DPWRST('XXX','BUG ')
6549      ELSE
6550        NCTEXT=1
6551        ICTEXT(NCTEXT)=ISYMBL(1:4)
6552        NCHTOT=10
6553        NCHDEC=5
6554C
6555        IF(IJUSSW.EQ.'ON')THEN
6556          DO3360I=1,NP
6557            PX1P=PX(I)
6558            PY1P=PY(I)
6559            CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
6560            ICSTR(1:6)='TEXT ('
6561            NCSTR=6
6562            NCHTOT=10
6563            NCHDEC=5
6564            CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
6565            ICSTR(17:17)=','
6566            NCSTR=17
6567            CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
6568            ICSTR(28:36)=') FINAL "'
6569            ICSTR(37:37)=ICTEXT(NCTEXT)
6570            ICSTR(38:39)='";'
6571            NCSTR=39
6572            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6573 3360     CONTINUE
6574        ELSE
6575          DO3310I=1,NP
6576            PX1P=PX(I)-PXINC
6577            PY1P=PY(I)-PYINC
6578            CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
6579            ICSTR(1:6)='TEXT ('
6580            NCSTR=6
6581            NCHTOT=10
6582            NCHDEC=5
6583            CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
6584            ICSTR(17:17)=','
6585            NCSTR=17
6586            CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
6587            ICSTR(28:36)=') FINAL "'
6588            ICSTR(37:37)=ICTEXT(NCTEXT)
6589            ICSTR(38:39)='";'
6590            NCSTR=39
6591            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
6592 3310     CONTINUE
6593        ENDIF
6594      ENDIF
6595C
6596      GOTO9000
6597C
6598C               ***************************************************
6599C               **  STEP 34--                                    **
6600C               **  TREAT THE CGM (BINARY)                 CASE  **
6601C               ***************************************************
6602C
6603 3400 CONTINUE
6604      GOTO9000
6605C
6606C               ******************************************************
6607C               **  STEP 41--                                       **
6608C               **  TREAT THE CALCOMP XXXXXX CASE                   **
6609C               **  TO DRAW A HORIZONTAL POLYMARKER--               **
6610C               **  WRITE OUT AN XXXXXXXXXX                         **
6611C               **  (NOT DONE)                                      **
6612C               **  REFERENCE--XX                                   **
6613C               **             XX                                   **
6614C               **             PAGES XX AND XX                      **
6615C               **  USE CALCOMP LIBRARY                             **
6616C               **      SYMBOL - WRITES TEXT                        **
6617C               **      CALCPT - DATAPLOT ROUTINE TO CONVERT FROM   **
6618C               **               PERCENT UNITS TO INCHES            **
6619C               **      CALCTR - DATAPLOT ROUTINE TO CONVERT        **
6620C               **               CHARACTER VARIABLE TO HOLLERITH    **
6621C               **               FORMAT (NOT NECCESARY ON ALL       **
6622C               **               SYSTEMS, BUT IS ON OTHERS.         **
6623C               ******************************************************
6624C
6625 4100 CONTINUE
6626C
6627      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
6628        WRITE(ICOUT,4162)
6629 4162   FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ',
6630     1         'THE CALCOMP DEVICE.')
6631        CALL DPWRST('XXX','BUG ')
6632      ELSE
6633        NCTEXT=1
6634        ICTEXT(1)=ISYMBL(1:4)
6635C
6636        DO4110I=1,NP
6637C
6638          PX1P=PX(I)-PXINC
6639          PY1P=PY(I)-PYINC
6640#ifdef HAVE_CALCOMP
6641          CALL CALCPT(PX1P,PY1P,AX,AY,ISUBN0)
6642#endif
6643          ANGLE=0.
6644          AXTEMP=0.
6645#ifdef HAVE_CALCOMP
6646          CALL CALCPT(AXTEMP,PHEIG2,AYTMP2,HEIGHT,ISUBN0)
6647          CALL CALCTR(ICTEXT(1),IHOLL,NCTEXT)
6648#endif
6649 4110   CONTINUE
6650      ENDIF
6651C
6652      GOTO9000
6653C
6654C               ******************************************************
6655C               **  STEP 46--                                       **
6656C               **  TREAT THE LAHEY   XXXXXX CASE                   **
6657C               **  REFERENCE--Programmer's Reference, Revision C   **
6658C               **             Lahey Computer Systems, January, 1992**
6659C               **             PAGES 51 THRU 65                     **
6660C               ******************************************************
6661C
6662 4600 CONTINUE
6663C
6664      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
6665        NCOL=INT(PHEIGH)
6666        IF(NCOL.LT.1)NCOL=1
6667        IF(IFONTH.EQ.0)THEN
6668          IXINC=0
6669        ELSEIF(IFONTH.EQ.1)THEN
6670          IXINC=NCOL/2
6671        ELSE
6672          IXINC=NCOL
6673        ENDIF
6674        IF(IFONTV.EQ.0)THEN
6675          IYINC=0
6676        ELSEIF(IFONTV.EQ.1)THEN
6677          IYINC=NCOL/2
6678        ELSE
6679          IYINC=NCOL
6680        ENDIF
6681#ifdef HAVE_LAHEY_CALCOMP
6682        CALL GRINFO(ILAHEY,RLAHEY,CLAHEY)
6683#endif
6684        IPEN=JCOL
6685        DO4670I=1,NP
6686          PX1=PX(I)
6687          PY1=PY(I)
6688#ifdef HAVE_LAHEY_CALCOMP
6689          CALL CALCPT(PX1,PY1,AX,AY,ISUBN0)
6690          CALL SETPIX(AX,AY,IPEN)
6691#endif
6692 4670   CONTINUE
6693      ELSE
6694C
6695        NCTEXT=1
6696        ICTEXT(1)=ISYMBL(1:4)
6697C
6698#ifdef HAVE_LAHEY_CALCOMP
6699        CALL GRINFO(ILAHEY,RLAHEY,CLAHEY)
6700#endif
6701        DO4610I=1,NP
6702          PX1P=PX(I)
6703          PY1P=PY(I)
6704#ifdef HAVE_LAHEY_CALCOMP
6705          CALL CALCPT(PX1P,PY1P,AX,AY,ISUBN0)
6706          ICOLMN=INT(REAL(ILAHEY(8))*(AX*RLAHEY(1)/11.0)+0.5)
6707#endif
6708          IF(IJUSTH.EQ.'RIGH')THEN
6709            NSHIFT=NCTEXT
6710          ELSEIF(IJUSTH.EQ.'CENT')THEN
6711            NSHIFT=NCTEXT/2
6712          ELSE
6713            NSHIFT=0
6714          ENDIF
6715          ICOLMN=ICOLMN-NSHIFT
6716          IF(ICOLMN.LT.1)ICOLMN=1
6717#ifdef HAVE_LAHEY_CALCOMP
6718          IF(ICOLMN.GT.ILAHEY(8))ICOLMN=ILAHEY(8)
6719          ILINE=INT(REAL(ILAHEY(9))*(RLAHEY(1)*(8.5-AY)/8.5)+0.5)
6720#endif
6721          IF(IJUSTV.EQ.'TOP')THEN
6722            NSHIFT=1
6723          ELSEIF(IJUSTV.EQ.'CENT')THEN
6724            NSHIFT=1
6725          ELSE
6726            NSHIFT=0
6727          ENDIF
6728          ILINE=ILINE-NSHIFT
6729          IF(ILINE.LT.1)ILINE=1
6730#ifdef HAVE_LAHEY_CALCOMP
6731          IF(ILINE.GT.ILAHEY(9))ILINE=ILAHEY(9)
6732          CALL GTEXT(ILINE,ICOLMN,ISYMBL)
6733#endif
6734C
6735 4610   CONTINUE
6736      ENDIF
6737C
6738      GOTO9000
6739C
6740C               ******************************************************
6741C               **  STEP 47--                                       **
6742C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
6743C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
6744C               ******************************************************
6745C
6746 4700 CONTINUE
6747C
6748      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
6749C
6750CCCCC   NOTE: QWIN DRIVER CURRENTLY SET TO USE 0 TO 100 COORDINATES.
6751CCCCC         THIS DOESN'T WORK SO WELL IF SETTING MULTIPLE PIXELS,
6752CCCCC         DOING IMAGE STUFF, ETC.  NEED TO UPDATE ALGORITHM BELOW
6753CCCCC         TO CONVERT PERCENTAGES TO ACTUAL PIXELS.  CURRENTLY, LIMIT
6754CCCCC         TO DRAWING A SINGLE PIXEL.
6755C
6756        NCOL=INT(PHEIGH)
6757        IF(NCOL.LT.1)NCOL=1
6758        IF(IFONTH.EQ.0)THEN
6759          IXINC=0
6760        ELSEIF(IFONTH.EQ.1)THEN
6761          IXINC=NCOL/2
6762        ELSE
6763          IXINC=NCOL
6764        ENDIF
6765        IF(IFONTV.EQ.0)THEN
6766          IYINC=0
6767        ELSEIF(IFONTV.EQ.1)THEN
6768          IYINC=NCOL/2
6769        ELSE
6770          IYINC=NCOL
6771        ENDIF
6772        DO4770I=1,NP
6773          PX1=PX(I)
6774          PY1=PY(I)
6775          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
6776          DO4775IROW=IX,IX+NCOL-1
6777            DO4778ICOLZ=IY,IY+NCOL-1
6778              IXTEMP=IROW-IXINC
6779              IYTEMP=ICOLZ-IYINC
6780#ifdef HAVE_QWIN
6781              IRESLT=SETPIXEL(INT2(IXTEMP),INT2(IYTEMP))
6782#endif
6783 4778       CONTINUE
6784 4775     CONTINUE
6785 4770   CONTINUE
6786C
6787      ELSE
6788        NCTEXT=1
6789        ICTEXT(1)=ISYMBL(1:4)
6790C
6791        IWIDTH=0
6792#ifdef HAVE_QWIN
6793        IWIDTH=GETGTEXTEXTENT(ISYMBL(1:1))
6794#endif
6795        IF(IFONTH.EQ.0)THEN
6796          IXINC=0
6797        ELSEIF(IFONTH.EQ.1)THEN
6798          IXINC=IWIDTH/2
6799        ELSE
6800          IXINC=IWIDTH
6801        ENDIF
6802        IF(IFONTV.EQ.0)THEN
6803          IYINC=0
6804        ELSEIF(IFONTV.EQ.1)THEN
6805          IYINC=INT(PHEIG2/2)
6806        ELSE
6807          IYINC=INT(PHEIG2)
6808        ENDIF
6809C
6810        DO4710I=1,NP
6811          PX1P=PX(I)
6812          PY1P=PY(I)
6813          CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
6814#ifdef HAVE_QWIN
6815          CALL MOVETO(INT2(IX-IXINC),INT2(IY-IYINC),WXY)
6816          CALL OUTGTEXT(ISYMBL)
6817#endif
6818 4710   CONTINUE
6819      ENDIF
6820C
6821      GOTO9000
6822C
6823C               ******************************************************
6824C               **  STEP 48--                                       **
6825C               **  TREAT THE OPEN-GL DRIVER                        **
6826C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
6827C               ******************************************************
6828C
6829 4800 CONTINUE
6830      IF(IOPGOF.EQ.'OFF')GOTO9000
6831C
6832      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
6833        NCOL=INT(PHEIGH)
6834        IF(NCOL.LT.1)NCOL=1
6835        IF(IFONTH.EQ.0)THEN
6836          IXINC=0
6837        ELSEIF(IFONTH.EQ.1)THEN
6838          IXINC=NCOL/2
6839        ELSE
6840          IXINC=NCOL
6841        ENDIF
6842        IF(IFONTV.EQ.0)THEN
6843          IYINC=0
6844        ELSEIF(IFONTV.EQ.1)THEN
6845          IYINC=NCOL/2
6846        ELSE
6847          IYINC=NCOL
6848        ENDIF
6849        DO4870I=1,NP
6850          PX1=PX(I)
6851          PY1=PY(I)
6852          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
6853          DO4875IROW=IX,IX+NCOL-1
6854            DO4878ICOLZ=IY,IY-NCOL+1,-1
6855              IXTEMP=IROW-IXINC
6856              IYTEMP=ICOLZ+IYINC
6857#ifdef HAVE_OPEN_GL
6858              CALL GLPOIN(IXTEMP,IYTEMP,PHEIGH)
6859#endif
6860 4878       CONTINUE
6861 4875     CONTINUE
6862 4870   CONTINUE
6863      ELSE
6864        CALL DPCOAN(ISYMBL(1:1),IJUNK)
6865        STRING(1)=IJUNK
6866        STRING(2)=0
6867C
6868        ILAST=80
6869        DO4810I=80,1,-1
6870          ILAST=I
6871          IF(IX11FN(I:I).NE.' ')GOTO4819
6872 4810   CONTINUE
6873 4819   CONTINUE
6874        DO4820I=1,ILAST
6875          CALL DPCOAN(IX11FN(I:I),IJUNK)
6876          IADE(I)=IJUNK
6877 4820   CONTINUE
6878        IADE(ILAST+1)=0
6879C
6880        IGLERR=0
6881#ifdef HAVE_OPEN_GL
6882        CALL GLTATT(IADE,IGLERR)
6883#endif
6884        IF(IGLERR.EQ.1) THEN
6885          WRITE(ICOUT,4821)
6886 4821     FORMAT(1X,'WARNING: X11 FONT NAME FOR OPEN-GL NOT FOUND.  ',
6887     1           'USE CURRENT FONT.')
6888          CALL DPWRST('XXX','BUG ')
6889        ELSEIF(IGLERR.EQ.2)THEN
6890          WRITE(ICOUT,4822)
6891 4822     FORMAT(1X,'WARNING: X11 FONT NAME FOR OPEN-GL NOT FOUND.  ',
6892     1           'USE DEFAULT FONT.')
6893          CALL DPWRST('XXX','BUG ')
6894        END IF
6895C
6896        IGLERR=0
6897C
6898        DO4850I=1,NP
6899          PX1=PX(I)
6900          PY1=PY(I)
6901          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
6902#ifdef HAVE_OPEN_GL
6903          CALL GLTEXH(STRING,IX,IY,IFONTH,IFONTV,IGLERR)
6904#endif
6905          IF(IGLERR.GT.0)THEN
6906            WRITE(ICOUT,4852)
6907 4852       FORMAT(1X,'ERROR: OPEN-GL PLOT SYMBOL RETURNED AN ERROR.')
6908            CALL DPWRST('XXX','BUG ')
6909          ENDIF
6910 4850   CONTINUE
6911      ENDIF
6912C
6913      GOTO9000
6914C
6915C               ******************************************************
6916C               **  STEP 49--                                       **
6917C               **  TREAT THE LAHEY INTERACTOR CASE                 **
6918C               ******************************************************
6919C
6920 4900 CONTINUE
6921C
6922      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
6923        NCOL=INT(PHEIGH)
6924        IF(NCOL.LT.1)NCOL=1
6925        IF(IFONTH.EQ.0)THEN
6926          IXINC=0
6927        ELSEIF(IFONTH.EQ.1)THEN
6928          IXINC=NCOL/2
6929        ELSE
6930          IXINC=NCOL
6931        ENDIF
6932        IF(IFONTV.EQ.0)THEN
6933          IYINC=0
6934        ELSEIF(IFONTV.EQ.1)THEN
6935          IYINC=NCOL/2
6936        ELSE
6937          IYINC=NCOL
6938        ENDIF
6939        DO4938I=1,NP
6940#ifdef HAVE_INTERACTER
6941          CALL IGrPoint(PX(I),PY(I))
6942#endif
6943 4938   CONTINUE
6944      ELSE
6945        GOTO9000
6946      ENDIF
6947C
6948      GOTO9000
6949C
6950C               ******************************************************
6951C               **  STEP 49B-                                       **
6952C               **  TREAT THE LAHEY WINTERACTOR CASE                **
6953C               ******************************************************
6954C
6955 4950 CONTINUE
6956C
6957      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
6958        NCOL=INT(PHEIGH)
6959        IF(NCOL.LT.1)NCOL=1
6960        IF(IFONTH.EQ.0)THEN
6961          IXINC=0
6962        ELSEIF(IFONTH.EQ.1)THEN
6963          IXINC=NCOL/2
6964        ELSE
6965          IXINC=NCOL
6966        ENDIF
6967        IF(IFONTV.EQ.0)THEN
6968          IYINC=0
6969        ELSEIF(IFONTV.EQ.1)THEN
6970          IYINC=NCOL/2
6971        ELSE
6972          IYINC=NCOL
6973        ENDIF
6974        DO4988I=1,NP
6975#ifdef HAVE_WININTERACTER
6976          CALL IGrPoint(PX(I),PY(I))
6977#endif
6978 4988   CONTINUE
6979      ELSE
6980        GOTO9000
6981      ENDIF
6982C
6983      GOTO9000
6984C
6985C
6986C               ******************************************************
6987C               **  STEP 41--                                       **
6988C               **  TREAT THE CALCOMP XXXXXX CASE                   **
6989C               **  TO DRAW A HORIZONTAL POLYMARKER--               **
6990C               **  WRITE OUT AN XXXXXXXXXX                         **
6991C               **  (NOT DONE)                                      **
6992C               **  REFERENCE--XX                                   **
6993C               **             XX                                   **
6994C               **             PAGES XX AND XX                      **
6995C               **  USE CALCOMP LIBRARY                             **
6996C               **      SYMBOL - WRITES TEXT                        **
6997C               **      CALCPT - DATAPLOT ROUTINE TO CONVERT FROM   **
6998C               **               PERCENT UNITS TO INCHES            **
6999C               **      CALCTR - DATAPLOT ROUTINE TO CONVERT        **
7000C               **               CHARACTER VARIABLE TO HOLLERITH    **
7001C               **               FORMAT (NOT NECCESARY ON ALL       **
7002C               **               SYSTEMS, BUT IS ON OTHERS.         **
7003C               ******************************************************
7004C
7005 5100 CONTINUE
7006C
7007      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
7008        WRITE(ICOUT,5162)
7009 5162   FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ',
7010     1         'THE ZETA DEVICE.')
7011        CALL DPWRST('XXX','BUG ')
7012      ELSE
7013        NCTEXT=1
7014        ICTEXT(1)=ISYMBL(1:4)
7015        DO5110I=1,NP
7016          PX1P=PX(I)-PXINC
7017          PY1P=PY(I)-PYINC
7018#ifdef HAVE_ZETA
7019          CALL CALCPT(PX1P,PY1P,AX,AY,ISUBN0)
7020#endif
7021          ANGLE=0.
7022          AXTEMP=0.
7023#ifdef HAVE_ZETA
7024          CALL CALCPT(AXTEMP,PHEIG2,AYTMP2,HEIGHT,ISUBN0)
7025          CALL CALCTR(ICTEXT(1),IHOLL,NCTEXT)
7026#endif
7027 5110   CONTINUE
7028      ENDIF
7029C
7030      GOTO9000
7031C
7032C               ******************************************************
7033C               **  STEP 66--                                       **
7034C               **  TREAT THE SUN CASE                              **
7035C               **  WRITTEN BY BILL ANDERSON                        **
7036C               ******************************************************
7037C
7038 6600 CONTINUE
7039C
7040      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
7041        NCOL=INT(PHEIGH)
7042        IF(NCOL.LT.1)NCOL=1
7043        IF(IFONTH.EQ.0)THEN
7044          IXINC=0
7045        ELSEIF(IFONTH.EQ.1)THEN
7046          IXINC=NCOL/2
7047        ELSE
7048          IXINC=NCOL
7049        ENDIF
7050        IF(IFONTV.EQ.0)THEN
7051          IYINC=0
7052        ELSEIF(IFONTV.EQ.1)THEN
7053          IYINC=NCOL/2
7054        ELSE
7055          IYINC=NCOL
7056        ENDIF
7057        DO6670I=1,NP
7058          PX1=PX(I)
7059          PY1=PY(I)
7060          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
7061          IX2=IX+NCOL-1
7062          IY2=IY+NCOL-1
7063#ifdef HAVE_SUN
7064        CALL cfrectangle(IX,IY,IX2,IY2)
7065#endif
7066 6670   CONTINUE
7067      ELSE
7068        ICSTR(1:1)=ISYMBL(1:1)
7069        ITEMP=0
7070        CALL DPCONA(ITEMP,ICSTR(2:2))
7071        DO6610I=1,NP
7072          PX1P = PX(I)-PXINC
7073          PY1P = PY(I)-PYINC
7074          CALL GRTRSD(PX1P,PY1P,IX1P,IY1P,ISUBN0)
7075#ifdef HAVE_SUN
7076          CALL cftext(IX1P,IY1P,ICSTR(1:2))
7077#endif
7078 6610   CONTINUE
7079      ENDIF
7080C
7081      GOTO9000
7082C
7083C               ******************************************************
7084C               **  STEP 81--                                       **
7085C               **  TREAT THE DEC  REGIS CASE                       **
7086C               **  TO DRAW A HORIZONTAL POLYMARKER--               **
7087C               **  USE THE P [ X, Y ] (= POSITION) INSTRUCTION     **
7088C               **  WITH INTEGER COORDINATES,                       **
7089C               **  AND THE   T ' STRING '  (= TEXT) INSTRUCTION    **
7090C               **  WITH THE DESIRED TEXT STRING,                   **
7091C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
7092C               **             PAGES 100 AND 118                    **
7093C               ******************************************************
7094C
7095C     MARCH, 1991.  PACK REGIS OUTPUT.  ALSO, REGIS DRAWS CHARACTER BELOW
7096C                   RATHER THAN ABOVE THE CURSUR POSITION (AS DATAPLOT
7097C                   ASSUMES), SO ADJUST Y COORDINATE BY ONE CHARACTER
7098C                   POSITION.
7099C
7100CCCCC SEPTEMBER 1995.  ADD "PIXEL" CAPABILITY.  DO A MOVE, THEN A V[]
7101CCCCC                  INSTRUCTION.
7102 8100 CONTINUE
7103C
7104      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
7105        NCOL=INT(PHEIGH)
7106        IF(NCOL.LT.1)NCOL=1
7107        IF(IFONTH.EQ.0)THEN
7108          IXINC=0
7109        ELSEIF(IFONTH.EQ.1)THEN
7110          IXINC=NCOL/2
7111        ELSE
7112          IXINC=NCOL
7113        ENDIF
7114        IF(IFONTV.EQ.0)THEN
7115          IYINC=0
7116        ELSEIF(IFONTV.EQ.1)THEN
7117          IYINC=NCOL/2
7118        ELSE
7119          IYINC=NCOL
7120        ENDIF
7121        DO8170I=1,NP
7122          PX1=PX(I)
7123          PY1=PY(I)
7124          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
7125          DO8175IROW=IX,IX+NCOL-1
7126            DO8178ICOLZ=IY,IY-NCOL+1,-1
7127              IXTEMP=IROW-IXINC
7128              IYTEMP=ICOLZ+IYINC
7129              ICSTR(1:2)='P['
7130              NCSTR=2
7131              NCHTOT=5
7132              CALL GRTRIN(IXTEMP,NCHTOT,ICSTR,NCSTR)
7133              ICSTR(8:8)=','
7134              NCSTR=8
7135              CALL GRTRIN(IYTEMP,NCHTOT,ICSTR,NCSTR)
7136              ICSTR(14:14)=']'
7137              ICSTR(15:17)='V[]'
7138              NCSTR=17
7139              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
7140 8178       CONTINUE
7141 8175     CONTINUE
7142 8170   CONTINUE
7143      ELSE
7144        NCTEXT=1
7145        ICTEXT(NCTEXT)=ISYMBL(1:4)
7146        NCTEP1=NCTEXT+1
7147        ICTEXT(NCTEP1)=''''
7148        NCSTR=0
7149        NCHTOT=5
7150        MAXREG=130
7151        ISIZE=16+NCTEP1
7152        DO8110I=1,NP
7153          IF(NCSTR.GT.MAXREG-ISIZE)THEN
7154            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
7155            NCSTR=0
7156          END IF
7157C
7158          PX1P=PX(I)-PXINC
7159          PY1P=PY(I)-PYINC
7160          PY1P=PY1P+PHEIG2
7161          CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
7162          NCSTR=NCSTR+1
7163          NCSTR2=NCSTR+1
7164          ICSTR(NCSTR:NCSTR2)='P['
7165          NCSTR=NCSTR2
7166          CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
7167          NCSTR=NCSTR+1
7168          ICSTR(NCSTR:NCSTR)=','
7169          CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
7170          NCSTR=NCSTR+1
7171          ICSTR(NCSTR:NCSTR)=']'
7172C
7173          NCSTR=NCSTR+1
7174          ICSTR(NCSTR:NCSTR)='T'
7175          NCSTR=NCSTR+1
7176          ICSTR(NCSTR:NCSTR)=''''
7177          DO8112J=1,NCTEP1
7178            K=J+NCSTR
7179            ICSTR(K:K)=ICTEXT(J)
7180 8112     CONTINUE
7181          NCSTR=K
7182C
7183 8110   CONTINUE
7184        IF(NCSTR.GT.0)CALL GRWRST(ICSTR,NCSTR,ISUBN0)
7185      ENDIF
7186C
7187      GOTO9000
7188C
7189C               ******************************************************
7190C               **  STEP 86--                                       **
7191C               **  TREAT THE POSTSCRIPT CASE                       **
7192C               **    XCOOR YCOOR MOVETO  (USE UNADJUSTED COORD.)   **
7193C               **  (ISYMBL) SHOW                                   **
7194C               **  RIGHTSHOW AND CENTSHOW ARE DATAPLOT DEFINED     **
7195C               **  PROCEDURES FOR PRINTING RIGHT AND CENTER        **
7196C               **  JUSTIFIED STRINGS RESPECTIVELY                  **
7197C               **  REFERENCE--POSTSCRIPT LANGUAGE TUTORIAL AND     **
7198C               **             COOKBOOOK,  ADOBE SYSTEMS            **
7199C               **  PAGE--37                                        **
7200C               ** CHECK FOR "(", ")", AND BACKSLASH.  IF FOUND,    **
7201C               ** PRECEDE WITH A BACKSLASH                         **
7202C               ******************************************************
7203CCCCC OCTOBER 1991.  MAKE POSTSCRIPT FONTS TABLE DRIVEN.
7204CCCCC SEPTEMBER 1995.  ADD PIXEL CAPABILITY.
7205C
7206 8600 CONTINUE
7207C
7208      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
7209        NCOL=INT(PHEIGH)
7210        IF(NCOL.LT.1)NCOL=1
7211        IF(IFONTH.EQ.0)THEN
7212          IXINC=0
7213        ELSEIF(IFONTH.EQ.1)THEN
7214          IXINC=NCOL/2
7215        ELSE
7216          IXINC=NCOL
7217        ENDIF
7218        IF(IFONTV.EQ.0)THEN
7219          IYINC=0
7220        ELSEIF(IFONTV.EQ.1)THEN
7221          IYINC=NCOL/2
7222        ELSE
7223          IYINC=NCOL
7224        ENDIF
7225        ICSTR(1:14)='1 setlinewidth'
7226        NCSTR=14
7227        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
7228        DO8670I=1,NP
7229          PX1=PX(I)
7230          PY1=PY(I)
7231          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
7232          IX=IX-IXINC
7233          IY=IY-IYINC
7234          IX2=IX+NCOL-1
7235          IY2=IY+NCOL-1
7236          DO8680ICOLZ=IY,IY2
7237            ICSTR(1:8)='newpath '
7238            NCSTR=8
7239            NCHTOT=5
7240            CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
7241            ICSTR(14:14)=' '
7242            NCSTR=14
7243            CALL GRTRIN(ICOLZ,NCHTOT,ICSTR,NCSTR)
7244            ICSTR(20:27)=' moveto '
7245            NCSTR=27
7246            CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
7247            ICSTR(33:33)=' '
7248            NCSTR=33
7249            CALL GRTRIN(ICOLZ,NCHTOT,ICSTR,NCSTR)
7250            ICSTR(39:52)=' lineto stroke'
7251            NCSTR=52
7252            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
7253 8680     CONTINUE
7254 8670   CONTINUE
7255      ELSE
7256        PHEIPP=ANUMVP*PHEIG2/100.
7257        IPSTPS=INT(PHEIPP+0.5)
7258        IF(IPSTFN.EQ.IPSTFC.AND.IPSTPC.EQ.IPSTPS)GOTO8605
7259C       FOLLOWING CODE MODIFIED OCTOBER 1991.
7260        IJUNK=7
7261        DO8695I=1,IPSTMF
7262          IF(IPSTFN.NE.IPSTT1(I))GOTO8695
7263          IJUNK=I
7264          GOTO8697
7265 8695   CONTINUE
7266 8697   CONTINUE
7267        ICSTR(1:1)='/'
7268        ICSTR(2:41)=IPSTT2(IJUNK)(1:40)
7269        ICSTR(42:51)=' findfont '
7270        NCHTOT=5
7271        NCSTR=51
7272        CALL GRTRIN(IPSTPS,NCHTOT,ICSTR,NCSTR)
7273        NCSTR=NCSTR+1
7274        NCSTR2=NCSTR+17
7275        ICSTR(NCSTR:NCSTR2)=' scalefont setfont'
7276        NCSTR=NCSTR2
7277        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
7278C
7279C       END OF CHANGE
7280C
7281        IPSTFC=IPSTFN
7282        IPSTPC=IPSTPS
7283C
7284 8605   CONTINUE
7285CCCCC   THE FOLLOWING 2 LINES WERE FIXED (SOFT-CODE BACKSLASH) APRIL 1989
7286        IF(ISYMBL.NE.'('.AND.ISYMBL.NE.')'.AND.ISYMBL.NE.IBASLC)THEN
7287          NCTEXT=1
7288          ICTEXT(NCTEXT)=ISYMBL(1:4)
7289        ELSE
7290          ICTEXT(1)=IBASLC
7291          NCTEXT=2
7292          ICTEXT(NCTEXT)=ISYMBL(1:4)
7293        ENDIF
7294C
7295        DO8610I=1,NP
7296C
7297CCCCC     6 LINES IN THE FOLLOWING SECTION WERE FIXED   MAY 1991 (ALAN)
7298          PX1P=PX(I)
7299          PY1P=PY(I)-PYINC
7300          ICSTR(1:4)='/IX '
7301          NCSTR=4
7302          CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
7303          NCHTOT=5
7304          CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
7305          ICSTR(10:18)=' def /IY '
7306          NCSTR=18
7307          CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
7308          ICSTR(24:29)=' def ('
7309          NCSTR=29
7310          DO8620J=1,NCTEXT
7311            NCSTR=NCSTR+1
7312            ICSTR(NCSTR:NCSTR)=ICTEXT(J)
7313 8620     CONTINUE
7314          NCSTR=NCSTR+1
7315          NCSTR2=NCSTR+1
7316          ICSTR(NCSTR:NCSTR2)=') '
7317          NCSTR=NCSTR2+1
7318          NCSTR2=NCSTR+8
7319          IF(IJUST(1:1).EQ.'L')ICSTR(NCSTR:NCSTR2)='leftshow '
7320          IF(IJUST(1:1).EQ.'C')ICSTR(NCSTR:NCSTR2)='centshow '
7321          IF(IJUST(1:1).EQ.'R')ICSTR(NCSTR:NCSTR2)='rightshow'
7322          NCSTR=NCSTR2
7323          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
7324 8610   CONTINUE
7325      ENDIF
7326C
7327      GOTO9000
7328C
7329C               ******************************************************
7330C               **  STEP 91--                                       **
7331C               **  TREAT THE QUIC LANDSCAPE AND PORTRAIT CASE      **
7332C               **  <ICARAT>IVvvvvv   - VERTICAL POSITION           **
7333C               **  <ICARAT>IHhhhhh   - HORIZONTAL POSITION         **
7334C               **  REFERENCE: QUIC PROGRAMMERS MANUAL -            **
7335C               **                                                  **
7336C               ******************************************************
7337C
7338 9100 CONTINUE
7339C
7340      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
7341        WRITE(ICOUT,9162)
7342 9162   FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ',
7343     1         'THE QMS DEVICE.')
7344        CALL DPWRST('XXX','BUG ')
7345      ELSE
7346C
7347        CALL DPCONA(94,ICARAT)
7348        IFONTT=IQUIFN
7349        IF(IORNSW.EQ.'PORT'.AND.(
7350     1     IFONTT.EQ.521.OR.
7351     1     IFONTT.EQ.522.OR.
7352     1     IFONTT.EQ.523.OR.
7353     1     IFONTT.EQ.524))IFONTT=10
7354        IF(IORNSW.NE.'PORT'.AND.(
7355     1     IFONTT.EQ.124.OR.
7356     1     IFONTT.EQ.144.OR.
7357     1     IFONTT.EQ.16.OR.
7358     1     IFONTT.EQ.328.OR.
7359     1     IFONTT.EQ.998.OR.
7360     1     IFONTT.EQ.404.OR.
7361     1     IFONTT.EQ.444.OR.
7362     1     IFONTT.EQ.532))IFONTT=10
7363        IF(IFONTT.EQ.IQUIFC)GOTO9105
7364        ICSTR(1:1)=ICARAT
7365        ICSTR(2:3)='IS'
7366        IQUIFC=IFONTT
7367        KFONT=IFONTT
7368        NCHTOT=-5
7369        NCSTR=3
7370        CALL GRTRIN(KFONT,NCHTOT,ICSTR,NCSTR)
7371        NCSTR=8
7372        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
7373C
7374 9105   CONTINUE
7375        NCTEXT=1
7376        ICTEXT(NCTEXT)=ISYMBL(1:4)
7377        NCSTR=0
7378        ANUMPP=ANUMHP
7379        IF(IJUST(1:1).EQ.'L')GOTO9109
7380        PXINC=PWIDT2
7381        IF(IFONTT.EQ.10)GOTO9108
7382        IF(IFONTT.EQ.404)GOTO9108
7383        IF(IFONTT.EQ.444)GOTO9108
7384        IF(IFONTT.EQ.521)GOTO9108
7385        IF(IFONTT.EQ.522)GOTO9108
7386        IF(IFONTT.EQ.523)GOTO9108
7387        IF(IFONTT.EQ.524)GOTO9108
7388        IF(IFONTT.EQ.532)GOTO9108
7389        IF(IFONTT.EQ.904)GOTO9108
7390        IF(IFONTT.EQ.924)GOTO9108
7391        IF(IFONTT.EQ.536)GOTO9108
7392        IF(IFONTT.EQ.517)GOTO9108
7393        IF(IFONTT.EQ.104)CALL QUICH1(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
7394        IF(IFONTT.EQ.124)CALL QUICH2(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
7395        IF(IFONTT.EQ.144)CALL QUICH3(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
7396        IF(IFONTT.EQ.16) CALL QUICH4(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
7397        IF(IFONTT.EQ.204)CALL QUICH5(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
7398        IF(IFONTT.EQ.328)CALL QUICH6(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
7399        IF(IFONTT.EQ.998)CALL QUICH7(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
7400        IF(IFONTT.EQ.664)CALL QUICH8(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP)
7401        PXINC=PXLECG
7402C
7403 9108   CONTINUE
7404        IF(IJUST(1:1).EQ.'C')PXINC=PXINC/2.
7405 9109   CONTINUE
7406C
7407        NCHTOT=-5
7408        DO9110I=1,NP
7409          PX1P=PX(I)-PXINC
7410          PY1P=PY(I)-PYINC
7411          PY1P=100.-PY1P
7412          CALL QUICPT(PX1P,PY1P,IX,IY,ISUBN0)
7413          ICSTR(6:6)=ICARAT
7414          ICSTR(7:8)='IH'
7415          NCSTR=8
7416          CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
7417          ICSTR(14:14)=ICARAT
7418          ICSTR(15:16)='IV'
7419          NCSTR=16
7420          CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
7421          ICSTR(22:22)=ICTEXT(NCTEXT)
7422          NCSTR=22
7423          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
7424 9110   CONTINUE
7425      ENDIF
7426C
7427      GOTO9000
7428C
7429C               ******************************************************
7430C               **  STEP 95--                                       **
7431C               **  TREAT THE X11        CASE                       **
7432C               ******************************************************
7433C
7434CCCCC SEPTEMBER 1995.  ADD "PIXEL" SYMBOL.  THIS IS A SPECIAL CASE
7435CCCCC TO TURN ON A SINGLE PIXEL.  IN THIS CASE, THE PHEIGH VARIABLE
7436CCCCC IS INTERPRETED AS AN INTEGER SCALE FACTOR, I.E. CHARACTER SIZE
7437CCCCC 6 WILL DRAW A PIXEL BOX 6 WIDE AND 6 HIGH.  THIS CAPABILITY BEING
7438CCCCC ADDED FOR FUTURE PLANNED IMPLEMENTATIONS, FOR EXAMPLE TO DO
7439CCCCC SOME IMAGE PROCESSING.
7440 9600 CONTINUE
7441C
7442#ifdef HAVE_X11
7443      IF(IX11OF.EQ.'OFF')GOTO9000
7444C
7445      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
7446        NCOL=INT(PHEIGH)
7447        IF(NCOL.LT.1)NCOL=1
7448        IF(IFONTH.EQ.0)THEN
7449          IXINC=0
7450        ELSEIF(IFONTH.EQ.1)THEN
7451          IXINC=NCOL/2
7452        ELSE
7453          IXINC=NCOL
7454        ENDIF
7455        IF(IFONTV.EQ.0)THEN
7456          IYINC=0
7457        ELSEIF(IFONTV.EQ.1)THEN
7458          IYINC=NCOL/2
7459        ELSE
7460          IYINC=NCOL
7461        ENDIF
7462        DO9670I=1,NP
7463          PX1=PX(I)
7464          PY1=PY(I)
7465          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
7466          DO9675IROW=IX,IX+NCOL-1
7467            DO9678ICOLZ=IY,IY-NCOL+1,-1
7468              IXTEMP=IROW-IXINC
7469              IYTEMP=ICOLZ+IYINC
7470              CALL XPOINT(IXTEMP,IYTEMP)
7471 9678       CONTINUE
7472 9675     CONTINUE
7473 9670   CONTINUE
7474      ELSE
7475        CALL DPCOAN(ISYMBL(1:1),IJUNK)
7476        STRING(1)=IJUNK
7477        STRING(2)=0
7478C
7479        ILAST=80
7480        DO9610I=80,1,-1
7481          ILAST=I
7482          IF(IX11FN(I:I).NE.' ')GOTO9619
7483 9610   CONTINUE
7484 9619   CONTINUE
7485        DO9620I=1,ILAST
7486          CALL DPCOAN(IX11FN(I:I),IJUNK)
7487          IADE(I)=IJUNK
7488 9620   CONTINUE
7489        IADE(ILAST+1)=0
7490C
7491        CALL XTATTR(IADE,IXERR)
7492        IF(IXERR.EQ.1) THEN
7493          WRITE(ICOUT,9621)
7494 9621     FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND.  USE ',
7495     1           'CURRENT FONT.')
7496          CALL DPWRST('XXX','BUG ')
7497        ELSEIF(IXERR.EQ.2)THEN
7498          WRITE(ICOUT,9622)
7499 9622     FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND.  USE ',
7500     1           'DEFAULT FONT.')
7501          CALL DPWRST('XXX','BUG ')
7502        END IF
7503C
7504        IXERR=0
7505C
7506        DO9650I=1,NP
7507          PX1=PX(I)
7508          PY1=PY(I)
7509          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
7510          CALL XTEXTH(STRING,IX,IY,IFONTH,IFONTV,IXERR)
7511 9650   CONTINUE
7512      ENDIF
7513#endif
7514      GOTO9000
7515C
7516C               *************************************************
7517C               **  STEP 100--                                 **
7518C               **  TREAT THE VGA VIA TURBO-C       CASE       **
7519C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
7520C               **             ENHANCEMENTS, PAGE 124, 113.    **
7521C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
7522C               **             PAGE 324-325, 256.              **
7523C               **  REFERENCE--WEISKAMP, POWER GRAPHICS        **
7524C               **             USING TURBO C, PAGE 59-60, 54-55**
7525C               *************************************************
7526C
752710000 CONTINUE
7528C
7529      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
7530        WRITE(ICOUT,10162)
753110162   FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ',
7532     1         'THE VGA DEVICE.')
7533        CALL DPWRST('XXX','BUG ')
7534      ELSE
7535C
7536CCCCC   THE FOLLOWING SECTION WAS REWRITTEN    SEPTEMBER 1995
7537        IF(ITCST.EQ.'CLOS')GOTO10099
7538C
7539        NCTEXT=1
7540        ICTEXT(NCTEXT)=ISYMBL(1:4)
7541C
7542        IC4='CECE'
7543CTURB   CALL TCSEJU(IC4)
7544        DO10100I=1,NP
7545           PX1P=PX(I)
7546           PY1P=PY(I)
7547           CALL GRTRSA(PX1P,PY1P,AX1,AY1,ISUBN0)
7548           PX1P=AX1
7549           PY1P=AY1
7550CTURB      CALL TCMOTO(PX1P,PY1P)
7551CTURB      CALL TCWRTE(ICTEXT,NCTEXT)
755210100   CONTINUE
755310099   CONTINUE
7554      ENDIF
7555C
7556      GOTO9000
7557C
7558C               ******************************************************
7559C               **  STEP 110--                                      **
7560C               **  TREAT THE GKS                DRIVER             **
7561C               ******************************************************
7562C
756311000 CONTINUE
7564      GOTO9000
7565C
7566C               ******************************************************
7567C               **  STEP 120--                                      **
7568C               **  TREAT THE GD                     DRIVER         **
7569C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
7570C               **  1) JPEG                                         **
7571C               **  2) PNG                                          **
7572C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
7573C               ******************************************************
7574C
757512000 CONTINUE
7576C
7577      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
7578        NCOL=INT(PHEIGH)
7579        IF(NCOL.LT.1)NCOL=1
7580        IF(IFONTH.EQ.0)THEN
7581          IXINC=0
7582        ELSEIF(IFONTH.EQ.1)THEN
7583          IXINC=NCOL/2
7584        ELSE
7585          IXINC=NCOL
7586        ENDIF
7587        IF(IFONTV.EQ.0)THEN
7588          IYINC=0
7589        ELSEIF(IFONTV.EQ.1)THEN
7590          IYINC=NCOL/2
7591        ELSE
7592          IYINC=NCOL
7593        ENDIF
7594        DO12670I=1,NP
7595          PX1=PX(I)
7596          PY1=PY(I)
7597          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
7598          DO12675IROW=IX,IX+NCOL-1
7599            DO12678ICOLZ=IY,IY-NCOL+1,-1
7600              IXTEMP=IROW-IXINC
7601              IYTEMP=ICOLZ+IYINC
7602#ifdef HAVE_GD
7603              CALL GDPOIN(IXTEMP,IYTEMP,JCOL)
7604#endif
760512678       CONTINUE
760612675     CONTINUE
760712670   CONTINUE
7608      ELSE
7609        IFONTZ=0
7610        IF(IGDFN(1:5).EQ.'SMALL')IFONTZ=1
7611        IF(IGDFN(1:5).EQ.'LARGE')IFONTZ=2
7612        IF(IGDFN(1:10).EQ.'MEDIUMBOLD')IFONTZ=3
7613        IF(IGDFN(1:5).EQ.'GIANT')IFONTZ=4
7614        IF(IGDFN(1:4).EQ.'TINY')IFONTZ=5
7615C
7616        ILAST=80
7617        DO12110I=80,1,-1
7618          ILAST=I
7619          IF(IGDFN(I:I).NE.' ')GOTO12119
762012110   CONTINUE
762112119   CONTINUE
7622        DO12120I=1,ILAST
7623          CALL DPCOAN(IGDFN(I:I),IJUNK)
7624          IADE(I)=IJUNK
762512120   CONTINUE
7626        IADE(ILAST+1)=0
7627C
7628        ILAST=16
7629        DO12130I=16,1,-1
7630          ILAST=I
7631          IF(ISYMBL(I:I).NE.' ')GOTO12139
763212130   CONTINUE
763312139   CONTINUE
7634        DO12140I=1,ILAST
7635          CALL DPCOAN(ISYMBL(I:I),IJUNK)
7636          STRING(I)=IJUNK
763712140   CONTINUE
7638        STRING(ILAST+1)=0
7639C
7640        JHEIG2=INT(PHEIG2+0.5)
7641        DO12650I=1,NP
7642          PX1=PX(I)
7643          PY1=PY(I)
7644          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
7645#ifdef HAVE_GD
7646          CALL GDTXTH(IADE,STRING,IFONTZ,IX,IY,IFONTH,IFONTV,
7647     1                JCOL,JHEIG2,IERR)
7648#endif
764912650   CONTINUE
7650      ENDIF
7651C
7652      GOTO9000
7653C
7654C               ******************************************************
7655C               **  STEP 130--                                      **
7656C               **  TREAT THE ABSOFT                 DRIVER         **
7657C               ******************************************************
7658C
765913000 CONTINUE
7660      GOTO9000
7661C
7662C               ******************************************************
7663C               **  STEP 135--                                      **
7664C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
7665C               ******************************************************
7666C
766713500 CONTINUE
7668C
7669      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
7670        NCOL=INT(PHEIGH)
7671        IF(NCOL.LT.1)NCOL=1
7672        IF(IFONTH.EQ.0)THEN
7673          IXINC=0
7674        ELSEIF(IFONTH.EQ.1)THEN
7675          IXINC=NCOL/2
7676        ELSE
7677          IXINC=NCOL
7678        ENDIF
7679        IF(IFONTV.EQ.0)THEN
7680          IYINC=0
7681        ELSEIF(IFONTV.EQ.1)THEN
7682          IYINC=NCOL/2
7683        ELSE
7684          IYINC=NCOL
7685        ENDIF
7686        DO13570I=1,NP
7687          PX1=PX(I)
7688          PY1=PY(I)
7689          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
7690          DO13575IROW=IX,IX+NCOL-1
7691            DO13578ICOLZ=IY,IY-NCOL+1,-1
7692              IXTEMP=IROW-IXINC
7693              IYTEMP=ICOLZ+IYINC
7694COLD          CALL aqpoin(IXTEMP,IYTEMP,JCOL)
769513578       CONTINUE
769613575     CONTINUE
769713570   CONTINUE
7698C
7699      ELSE
7700        CALL DPCOAN(ISYMBL(1:1),IJUNK)
7701        STRING(1)=IJUNK
7702        STRING(2)=0
7703C
7704        ILAST=80
7705        DO13510I=80,1,-1
7706          ILAST=I
7707          IF(IAQUFN(I:I).NE.' ')GOTO13519
770813510   CONTINUE
770913519   CONTINUE
7710        DO13520I=1,ILAST
7711          CALL DPCOAN(IAQUFN(I:I),IJUNK)
7712          IADE(I)=IJUNK
771313520   CONTINUE
7714        IADE(ILAST+1)=0
7715C
7716        DO13550I=1,NP
7717          PX1=PX(I)
7718          PY1=PY(I)
7719          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
7720#ifdef HAVE_AQUA
7721          CALL aqtxth(STRING,IX,IY,IFONTH,IFONTV,IADE,IXERR)
7722#endif
772313550   CONTINUE
7724      ENDIF
7725      GOTO9000
7726C
7727C
7728C               ******************************************************
7729C               **  STEP 150--                                      **
7730C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
7731C               ******************************************************
7732C
773315000 CONTINUE
7734C
7735      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
7736C
7737C       FOR LATEX DRIVER, "PIXEL" MODE NOT CURRENTLY SUPPORTED
7738C
7739        GOTO9000
7740      ELSE
7741        IF(IJUST.EQ.'LEFT')THEN
7742          ICJUNK='bl'
7743        ELSEIF(IJUST.EQ.'CENT')THEN
7744          ICJUNK='bc'
7745        ELSEIF(IJUST.EQ.'RIGH')THEN
7746          ICJUNK='br'
7747        ELSEIF(IJUST.EQ.'LJUS')THEN
7748          ICJUNK='bl'
7749        ELSEIF(IJUST.EQ.'CJUS')THEN
7750          ICJUNK='bc'
7751        ELSEIF(IJUST.EQ.'RJUS')THEN
7752          ICJUNK='br'
7753        ELSEIF(IJUST.EQ.'LEBO')THEN
7754          ICJUNK='bl'
7755        ELSEIF(IJUST.EQ.'CEBO')THEN
7756          ICJUNK='bc'
7757        ELSEIF(IJUST.EQ.'RIBO')THEN
7758          ICJUNK='br'
7759        ELSEIF(IJUST.EQ.'LECE')THEN
7760          ICJUNK='cl'
7761        ELSEIF(IJUST.EQ.'CECE')THEN
7762          ICJUNK='cc'
7763        ELSEIF(IJUST.EQ.'RICE')THEN
7764          ICJUNK='cr'
7765        ELSEIF(IJUST.EQ.'LETO')THEN
7766          ICJUNK='tl'
7767        ELSEIF(IJUST.EQ.'CETO')THEN
7768          ICJUNK='tc'
7769        ELSEIF(IJUST.EQ.'RITO')THEN
7770          ICJUNK='tr'
7771        ELSE
7772          ICJUNK='cc'
7773        ENDIF
7774C
7775        DO15650I=1,NP
7776C
7777          PX1=PX(I)
7778          PY1=PY(I)
7779          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
7780C
7781          ICSTR(1:1)=IBASLC
7782          ICSTR(2:5)='put('
7783          NCSTR=5
7784          NCHTOT=5
7785          CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
7786          NCSTR=NCSTR+1
7787          ICSTR(NCSTR:NCSTR)=','
7788          CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
7789          NCSTR=NCSTR+1
7790          ICSTR(NCSTR:NCSTR+15)='){ makebox(0,0)['
7791          ICSTR(NCSTR+2:NCSTR+2)=IBASLC
7792          NCSTR=NCSTR+15
7793          ICSTR(NCSTR+1:NCSTR+2)=ICJUNK(1:2)
7794          NCSTR=NCSTR+2
7795C
7796          NCSTR=NCSTR+1
7797          ICSTR(NCSTR:NCSTR)=']'
7798C
7799          NCSTR=NCSTR+1
7800          ICSTR(NCSTR:NCSTR)='{'
7801          NCSTR=NCSTR+1
7802          ICSTR(NCSTR:NCSTR)=ISYMBL(1:1)
7803          NCSTR=NCSTR+1
7804          ICSTR(NCSTR:NCSTR+1)='}}'
7805          NCSTR=NCSTR+1
7806          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
7807C
780815650   CONTINUE
7809      ENDIF
7810C
7811      GOTO9000
7812C
7813C               ******************************************************
7814C               **  STEP 160--                                      **
7815C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
7816C               ******************************************************
7817C
7818C     JULY 2015.  FOR THE CHROME BROWSER, NEED TO HAVE
7819C
7820C                   X="95" Y="233"
7821C
7822C                 RATHER THAN
7823C
7824C                   X="   95" Y="   233"
7825C
782616000 CONTINUE
7827C
7828      CALL DPCONA(34,IQUOTE)
7829C
7830      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
7831CCCCC   "PIXEL" OPTION: USE FILLED RECTANGLE TO DRAW
7832        IFONTH=0
7833        IF(IJUSTH.EQ.'C')IFONTH=1
7834        IF(IJUSTH.EQ.'R')IFONTH=2
7835        IFONTV=0
7836        IF(IJUSTV.EQ.'B')IFONTV=1
7837        IF(IJUSTV.EQ.'T')IFONTV=2
7838        NCOL=INT(PHEIGH)
7839        IF(NCOL.LT.1)NCOL=1
7840        IF(IFONTH.EQ.0)THEN
7841          IXINC=0
7842        ELSEIF(IFONTH.EQ.1)THEN
7843          IXINC=NCOL/2
7844        ELSE
7845          IXINC=NCOL
7846        ENDIF
7847        IF(IFONTV.EQ.0)THEN
7848          IYINC=0
7849        ELSEIF(IFONTV.EQ.1)THEN
7850          IYINC=NCOL/2
7851        ELSE
7852          IYINC=NCOL
7853        ENDIF
7854C
7855        DO16070I=1,NP
7856          PX1=PX(I)
7857          PY1=PY(I)
7858          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
7859          IX=IX-IXINC
7860          IY=IY-IYINC
7861          IX2=IX+NCOL-1
7862          IY2=IY+NCOL-1
7863
7864          ICSTR(1:11)='   <rect x='
7865          ICSTR(12:12)=IQUOTE
7866          NCSTR=12
7867          NCHTOT=5
7868          CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
7869          NCSTR=NCSTR+1
7870          ICSTR(NCSTR:NCSTR)=IQUOTE
7871          NCSTR=NCSTR+1
7872          ICSTR(NCSTR:NCSTR+2)=' y='
7873          NCSTR=NCSTR+3
7874          ICSTR(NCSTR:NCSTR)=IQUOTE
7875          CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
7876          NCSTR=NCSTR+1
7877          ICSTR(NCSTR:NCSTR)=IQUOTE
7878          NCSTR=-NCSTR
7879          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
7880C
7881          ICSTR(1:15)='         width='
7882          ICSTR(16:16)=IQUOTE
7883          NCSTR=16
7884          CALL GRTRIN(NCOL,NCHTOT,ICSTR,NCSTR)
7885          NCSTR=NCSTR+1
7886          ICSTR(NCSTR:NCSTR)=IQUOTE
7887          NCSTR=NCSTR+1
7888          ICSTR(NCSTR:NCSTR+7)=' height='
7889          NCSTR=NCSTR+8
7890          ICSTR(NCSTR:NCSTR)=IQUOTE
7891          CALL GRTRIN(NCOL,NCHTOT,ICSTR,NCSTR)
7892          NCSTR=NCSTR+1
7893          ICSTR(NCSTR:NCSTR)=IQUOTE
7894          NCSTR=-NCSTR
7895          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
7896C
7897          ICSTR(1:17)='           style='
7898          ICSTR(18:18)=IQUOTE
7899          ICSTR(19:31)='stroke:none; '
7900          NCSTR=-31
7901          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
7902          ICSTR(1:19)='             fill:#'
7903          NCSTR=19
7904          NCHTOT=2
7905          JTEMP=JCOL
7906          IF(JTEMP.LE.0)THEN
7907C
7908C           DATAPLOT CURRENTLY ALLOWS GREYSCALE VALUES IN
7909C           THE RANGE 0 TO 100.  FOR SPECIFYING COLOR TO SVG,
7910C           SCALE THAT 0 TO 100 VALUE TO A 0 TO 255 VALUE.
7911C
7912            AVAL=(255./100.)*REAL(ABS(JTEMP))
7913            IF(AVAL.LE.0.0)AVAL=0.0
7914            IF(AVAL.GE.255.0)AVAL=255.0
7915            JRED=INT(AVAL+0.5)
7916            JBLUE=JRED
7917            JGREEN=JRED
7918          ELSE
7919            IF(JTEMP.LT.1 .OR. JTEMP.GT.MAXCLR)JTEMP=1
7920            JRED=IRED(JTEMP)
7921            JGREEN=IGREEN(JTEMP)
7922            JBLUE=IBLUE(JTEMP)
7923          ENDIF
7924          CALL DPCONX(JRED,ICJUNK)
7925          NCSTR=NCSTR+1
7926          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
7927          NCSTR=NCSTR+1
7928          CALL DPCONX(JGREEN,ICJUNK)
7929          NCSTR=NCSTR+1
7930          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
7931          NCSTR=NCSTR+1
7932          CALL DPCONX(JBLUE,ICJUNK)
7933          NCSTR=NCSTR+1
7934          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
7935          NCSTR=NCSTR+2
7936          ICSTR(NCSTR:NCSTR)=IQUOTE
7937          NCSTR=-NCSTR
7938          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
7939          ICSTR(1:7)='     />'
7940          NCSTR=-7
7941          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
794216070   CONTINUE
7943      ELSE
7944        NSYMB=1
7945        DO16001J=16,1,-1
7946          IF(ISYMBL(J:J).NE.' ')THEN
7947            NSYMB=J
7948            GOTO16002
7949          ENDIF
795016001   CONTINUE
795116002   CONTINUE
7952C
7953        RATIV1=ANUMVP/100.0
7954        PHEIPP=RATIV1*PHEIG2
7955        JHEIG2=INT(PHEIPP+0.5)
7956C
7957        ISVGLN=ISVGLN+1
7958        ICSTR(1:9)='   <g id='
7959        ICSTR(10:10)=IQUOTE
7960        NCSTR=10
7961        IF(ISVGLN.LE.9)THEN
7962          NCHTOT=1
7963        ELSEIF(ISVGLN.LE.99)THEN
7964          NCHTOT=2
7965        ELSEIF(ISVGLN.LE.999)THEN
7966          NCHTOT=3
7967        ELSEIF(ISVGLN.LE.9999)THEN
7968          NCHTOT=4
7969        ELSEIF(ISVGLN.LE.99999)THEN
7970          NCHTOT=5
7971        ELSE
7972          NCHTOT=6
7973        ENDIF
7974        CALL GRTRIN(ISVGLN,NCHTOT,ICSTR,NCSTR)
7975        NCSTR=NCSTR+1
7976        ICSTR(NCSTR:NCSTR)=IQUOTE
7977        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
7978C
7979        IF(ISVGSS(1:3).EQ.'EXT')THEN
7980          NCSTR=12
7981          ICSTR(1:NCSTR)='      class='
7982          NCSTR=NCSTR+1
7983          ICSTR(NCSTR:NCSTR)=IQUOTE
7984          NCSTR=NCSTR+1
7985C
7986          IF(IJUSTH.EQ.'CENT')THEN
7987            ICSTR(NCSTR:NCSTR+16)='center-horizontal'
7988            NCSTR=NCSTR+17
7989          ELSEIF(IJUSTH.EQ.'LEFT')THEN
7990            ICSTR(NCSTR:NCSTR+14)='left-horizontal'
7991            NCSTR=NCSTR+15
7992          ELSEIF(IJUSTH.EQ.'RIGH')THEN
7993            ICSTR(NCSTR:NCSTR+15)='right-horizontal'
7994            NCSTR=NCSTR+16
7995          ENDIF
7996C
7997          ICSTR(NCSTR:NCSTR)=IQUOTE
7998          NCSTR=-NCSTR
7999          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8000C
8001          CALL GRTRCO('FORE',ISVGFC,JCOL2)
8002          IFLAG=1
8003          ICSTR(1:12)='      style='
8004          ICSTR(13:13)=IQUOTE
8005          ICSTR(14:31)='stroke:none;fill:#'
8006          NCSTR=31
8007          NCHTOT=2
8008          JTEMP=JCOL
8009          IF(JTEMP.LE.0)THEN
8010C
8011C           DATAPLOT CURRENTLY ALLOWS GREYSCALE VALUES IN
8012C           THE RANGE 0 TO 100.  FOR SPECIFYING COLOR TO SVG,
8013C           SCALE THAT 0 TO 100 VALUE TO A 0 TO 255 VALUE.
8014C
8015            AVAL=(255./100.)*REAL(ABS(JTEMP))
8016            IF(AVAL.LE.0.0)AVAL=0.0
8017            IF(AVAL.GE.255.0)AVAL=255.0
8018            JRED=INT(AVAL+0.5)
8019            JBLUE=JRED
8020            JGREEN=JRED
8021          ELSE
8022            IF(JTEMP.LT.1 .OR. JTEMP.GT.MAXCLR)JTEMP=1
8023            JRED=IRED(JTEMP)
8024            JGREEN=IGREEN(JTEMP)
8025            JBLUE=IBLUE(JTEMP)
8026          ENDIF
8027          CALL DPCONX(JRED,ICJUNK)
8028          NCSTR=NCSTR+1
8029          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
8030          NCSTR=NCSTR+1
8031          CALL DPCONX(JGREEN,ICJUNK)
8032          NCSTR=NCSTR+1
8033          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
8034          NCSTR=NCSTR+1
8035          CALL DPCONX(JBLUE,ICJUNK)
8036          NCSTR=NCSTR+1
8037          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
8038          NCSTR=NCSTR+2
8039          ICSTR(NCSTR:NCSTR)=';'
8040          NCSTR=-NCSTR
8041          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8042C
8043          NCSTR=22
8044          ICSTR(1:NCSTR)='            font-size:'
8045          NCHTOT=3
8046          CALL GRTRIN(JHEIG2,NCHTOT,ICSTR,NCSTR)
8047          NCSTR=NCSTR+1
8048          ICSTR(NCSTR:NCSTR+2)='pt;'
8049          NCSTR=NCSTR+2
8050          NCSTR=-NCSTR
8051          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8052C
8053          IF(IFLAG.EQ.1)THEN
8054            NCSTR=13
8055            ICSTR(1:NCSTR)='             '
8056            NCSTR=NCSTR+1
8057            ICSTR(NCSTR:NCSTR)=IQUOTE
8058            NCSTR=NCSTR+1
8059            ICSTR(NCSTR:NCSTR)='>'
8060            NCSTR=-NCSTR
8061            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8062          ENDIF
8063C
8064        ELSE
8065          NCSTR=14
8066          ICSTR(1:NCSTR)='        style='
8067          NCSTR=NCSTR+1
8068          ICSTR(NCSTR:NCSTR)=IQUOTE
8069          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8070C
8071          NCSTR=21
8072          ICSTR(1:NCSTR)='         font-family:'
8073          DO16007II=32,1,-1
8074            NCTEMP=II
8075            IF(ISVGFN(II:II).NE.' ')GOTO16008
807616007     CONTINUE
807716008     CONTINUE
8078          NCSTR=NCSTR+1
8079          ICSTR(NCSTR:NCSTR+NCTEMP-1)=ISVGFN(1:NCTEMP)
8080          NCSTR=NCSTR+NCTEMP
8081          ICSTR(NCSTR:NCSTR)=';'
8082          NCSTR=-NCSTR
8083          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8084          IF(ISVGFW.EQ.'NORM')THEN
8085            NCSTR=28
8086            ICSTR(1:NCSTR)='         font-weight:normal;'
8087            NCSTR=-NCSTR
8088          ELSE
8089            NCSTR=26
8090            ICSTR(1:NCSTR)='         font-weight:bold;'
8091            NCSTR=-NCSTR
8092          ENDIF
8093          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8094          IF(ISVGST.EQ.'ITAL')THEN
8095            NCSTR=27
8096            ICSTR(1:NCSTR)='         font-style:italic;'
8097            NCSTR=-NCSTR
8098          ELSE
8099            NCSTR=27
8100            ICSTR(1:NCSTR)='         font-style:normal;'
8101            NCSTR=-NCSTR
8102          ENDIF
8103          NCSTR=19
8104          ICSTR(1:NCSTR)='         font-size:'
8105          NCHTOT=3
8106          CALL GRTRIN(JHEIG2,NCHTOT,ICSTR,NCSTR)
8107          NCSTR=NCSTR+1
8108          ICSTR(NCSTR:NCSTR+2)='pt;'
8109          NCSTR=NCSTR+2
8110          NCSTR=-NCSTR
8111          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8112C
8113          NCSTR=28
8114          ICSTR(1:NCSTR)='         stroke:none; fill:#'
8115          NCHTOT=2
8116          JTEMP=JCOL
8117          IF(JTEMP.LE.0)THEN
8118C
8119C           DATAPLOT CURRENTLY ALLOWS GREYSCALE VALUES IN
8120C           THE RANGE 0 TO 100.  FOR SPECIFYING COLOR TO SVG,
8121C           SCALE THAT 0 TO 100 VALUE TO A 0 TO 255 VALUE.
8122C
8123            AVAL=(255./100.)*REAL(ABS(JTEMP))
8124            IF(AVAL.LE.0.0)AVAL=0.0
8125            IF(AVAL.GE.255.0)AVAL=255.0
8126            JRED=INT(AVAL+0.5)
8127            JBLUE=JRED
8128            JGREEN=JRED
8129          ELSE
8130            IF(JTEMP.LT.1 .OR. JTEMP.GT.MAXCLR)JTEMP=1
8131            JRED=IRED(JTEMP)
8132            JGREEN=IGREEN(JTEMP)
8133            JBLUE=IBLUE(JTEMP)
8134          ENDIF
8135          CALL DPCONX(JRED,ICJUNK)
8136          NCSTR=NCSTR+1
8137          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
8138          NCSTR=NCSTR+1
8139          CALL DPCONX(JGREEN,ICJUNK)
8140          NCSTR=NCSTR+1
8141          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
8142          NCSTR=NCSTR+1
8143          CALL DPCONX(JBLUE,ICJUNK)
8144          NCSTR=NCSTR+1
8145          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
8146          NCSTR=NCSTR+2
8147          ICSTR(NCSTR:NCSTR)=';'
8148C
8149          NCSTR=NCSTR+1
8150          ICSTR(NCSTR:NCSTR)=IQUOTE
8151          NCSTR=NCSTR+1
8152          ICSTR(NCSTR:NCSTR)='>'
8153          NCSTR=-NCSTR
8154          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8155C
8156        ENDIF
8157C
8158        DO16010I=1,NP
8159C
8160          PX1P=PX(I)
8161          PY1P=PY(I)
8162          CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
8163C
8164          IF(IJUSTV.EQ.'TOP')THEN
8165            IY=IY+JHEIG2
8166          ELSEIF(IJUSTV.EQ.'CENT')THEN
8167            IY=IY+(JHEIG2/2)
8168          ELSE
8169            CONTINUE
8170          ENDIF
8171C
8172          IF(IX.LE.9)THEN
8173            NCHTOT=1
8174          ELSEIF(IX.LE.99)THEN
8175            NCHTOT=2
8176          ELSEIF(IX.LE.999)THEN
8177            NCHTOT=3
8178          ELSEIF(IX.LE.9999)THEN
8179            NCHTOT=4
8180          ELSE
8181            NCHTOT=5
8182          ENDIF
8183C
8184          ICSTR(1:11)='   <text x='
8185          NCSTR=12
8186          ICSTR(NCSTR:NCSTR)=IQUOTE
8187          CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
8188          NCSTR=NCSTR+1
8189          ICSTR(NCSTR:NCSTR)=IQUOTE
8190          NCSTR=NCSTR+1
8191          ICSTR(NCSTR:NCSTR+2)=' y='
8192          NCSTR=NCSTR+3
8193          ICSTR(NCSTR:NCSTR)=IQUOTE
8194C
8195          IF(IY.LE.9)THEN
8196            NCHTOT=1
8197          ELSEIF(IY.LE.99)THEN
8198            NCHTOT=2
8199          ELSEIF(IY.LE.999)THEN
8200            NCHTOT=3
8201          ELSEIF(IY.LE.9999)THEN
8202            NCHTOT=4
8203          ELSE
8204            NCHTOT=5
8205          ENDIF
8206C
8207          CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
8208          NCHTOT=5
8209          NCSTR=NCSTR+1
8210          ICSTR(NCSTR:NCSTR)=IQUOTE
8211C
8212          ICSTR(NCSTR+1:NCSTR+7)=' style='
8213          NCSTR=NCSTR+8
8214          ICSTR(NCSTR:NCSTR)=IQUOTE
8215          IF(IJUSTH.EQ.'CENT')THEN
8216            ICSTR(NCSTR+1:NCSTR+19)='text-anchor:middle;'
8217            NCSTR=NCSTR+19
8218          ELSEIF(IJUSTH.EQ.'RIGH')THEN
8219            ICSTR(NCSTR+1:NCSTR+16)='text-anchor:end;'
8220            NCSTR=NCSTR+16
8221          ELSE
8222            ICSTR(NCSTR+1:NCSTR+18)='text-anchor:start;'
8223            NCSTR=NCSTR+18
8224          ENDIF
8225C
8226          NCSTR=NCSTR+1
8227          ICSTR(NCSTR:NCSTR)=IQUOTE
8228          NCSTR=NCSTR+1
8229          ICSTR(NCSTR:NCSTR)='>'
8230C
8231C         2012/3: CHECK FOR "<" OR ">".  NEED TO CONVERT THESE TO
8232C                 &lt; AND &gt; TO DISTINGUISH THEM FROM TAG IDENTIFIERS.
8233C         2015/11: CHECK FOR "&".  NEED TO CONVERT THESE TO &amp; .
8234C
8235          DO16012J=1,NSYMB
8236            IF(ISYMBL(J:J).EQ.'<')THEN
8237              NCSTR=NCSTR+1
8238              ICSTR(NCSTR:NCSTR+3)='&lt;'
8239              NCSTR=NCSTR+3
8240            ELSEIF(ISYMBL(J:J).EQ.'>')THEN
8241              NCSTR=NCSTR+1
8242              ICSTR(NCSTR:NCSTR+3)='&gt;'
8243              NCSTR=NCSTR+3
8244            ELSEIF(ICTEXT(J).EQ.'&')THEN
8245              NCSTR=NCSTR+1
8246              ICSTR(NCSTR:NCSTR+4)='&amp;'
8247              NCSTR=NCSTR+4
8248            ELSE
8249              NCSTR=NCSTR+1
8250              ICSTR(NCSTR:NCSTR)=ISYMBL(J:J)
8251            ENDIF
825216012     CONTINUE
8253C
8254          ICSTR(NCSTR+1:NCSTR+7)='</text>'
8255          NCSTR=NCSTR+7
8256          NCSTR=-NCSTR
8257          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8258C
825916010   CONTINUE
8260C
8261        ICSTR(1:7)='   </g>'
8262        NCSTR=-7
8263        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8264C
8265      ENDIF
8266C
8267      GOTO9000
8268C
8269C               ******************************************************
8270C               **  STEP 170--                                      **
8271C               **  TREAT THE CAIRO                          DRIVER **
8272C               ******************************************************
8273C
827417000 CONTINUE
8275      IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN
8276        NCOL=INT(PHEIGH)
8277        IF(NCOL.LT.1)NCOL=1
8278        IF(IFONTH.EQ.0)THEN
8279          IXINC=0
8280        ELSEIF(IFONTH.EQ.1)THEN
8281          IXINC=NCOL/2
8282        ELSE
8283          IXINC=NCOL
8284        ENDIF
8285        IF(IFONTV.EQ.0)THEN
8286          IYINC=0
8287        ELSEIF(IFONTV.EQ.1)THEN
8288          IYINC=NCOL/2
8289        ELSE
8290          IYINC=NCOL
8291        ENDIF
8292C
8293        IVAL2=1
8294        IF(IGUNIT.EQ.IPL1NU)IVAL2=2
8295        IF(IGUNIT.EQ.IPL2NU)IVAL2=3
8296C
8297        DO17670I=1,NP
8298          PX1=PX(I)
8299          PY1=PY(I)
8300          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
8301          DO17675IROW=IX,IX+NCOL-1
8302            DO17678ICOLZ=IY,IY-NCOL+1,-1
8303              IXTEMP=IROW-IXINC
8304              IYTEMP=ICOLZ+IYINC
8305#ifdef HAVE_CAIRO
8306              CALL CAPOIN(IVAL2,IXTEMP,IYTEMP)
8307#endif
830817678       CONTINUE
830917675     CONTINUE
831017670   CONTINUE
8311      ELSE
8312C
8313C     CHECK FOR X11 DEVICE, HARDWARE TEXT NOT SUPPORTED
8314C
8315        IVAL1=0
8316        IF(IMODEL.EQ.'X11')IVAL1=1
8317        IVAL2=1
8318        IF(IGUNIT.EQ.IPL1NU)IVAL2=2
8319        IF(IGUNIT.EQ.IPL2NU)IVAL2=3
8320CCCCC   IF(IVAL2.EQ.1 .AND. IVAL1.EQ.1)THEN
8321CCCCC     WRITE(ICOUT,999)
8322CCCCC     CALL DPWRST('XXX','BUG ')
8323CCCCC     WRITE(ICOUT,17006)
8324C17006     FORMAT('***** WARNING: HARDWARE TEXT NOT SUPPORTED ON ',
8325CCCCC1           'CAIRO X11 DEVICE.')
8326CCCCC     CALL DPWRST('XXX','BUG ')
8327CCCCC     GOTO9000
8328CCCCC   ENDIF
8329C
8330        ILAST=32
8331        DO17110I=32,1,-1
8332          ILAST=I
8333          IF(ICAIFN(I:I).NE.' ')GOTO17119
833417110   CONTINUE
833517119   CONTINUE
8336        DO17120I=1,ILAST
8337          CALL DPCOAN(ICAIFN(I:I),IJUNK)
8338          IADE(I)=IJUNK
833917120 CONTINUE
8340        IADE(ILAST+1)=0
8341C
8342        ILAST=16
8343        DO17130I=16,1,-1
8344          ILAST=I
8345          IF(ISYMBL(I:I).NE.' ')GOTO17139
834617130   CONTINUE
834717139   CONTINUE
8348        DO17140I=1,ILAST
8349          CALL DPCOAN(ISYMBL(I:I),IJUNK)
8350          STRING(I)=IJUNK
835117140   CONTINUE
8352        STRING(ILAST+1)=0
8353C
8354        AHEIG2=REAL(JHEIG2)
8355        IVAL2=1
8356        IF(IGUNIT.EQ.IPL1NU)IVAL2=2
8357        IF(IGUNIT.EQ.IPL2NU)IVAL2=3
8358        DO17650I=1,NP
8359          PX1=PX(I)
8360          PY1=PY(I)
8361          CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
8362          AX1=PX1
8363          AY1=PY1
8364C
8365#ifdef HAVE_CAIRO
8366          IVAL3=1
8367          IF(ICAISL.EQ.'ITAL')IVAL3=2
8368          IVAL4=2
8369          IF(ICAIFW.EQ.'BOLD')IVAL4=2
8370          CALL CATXTH(IVAL2,STRING,AX1,AY1,IFONTH,IFONTV,AHEIG2,
8371     1                IADE,IVAL3,IVAL4,IERR)
8372#endif
837317650   CONTINUE
8374      ENDIF
8375C
8376      GOTO9000
8377C
8378C               ******************************************************
8379C               **  STEP 180--                                      **
8380C               **  TREAT THE WMF                            DRIVER **
8381C               ******************************************************
8382C
838318000 CONTINUE
8384      GOTO9000
8385C
8386C               ******************************************************
8387C               **  STEP 190--                                      **
8388C               **  TREAT THE D3                             DRIVER **
8389C               ******************************************************
8390C
839119000 CONTINUE
8392      GOTO9000
8393C
8394C               *****************
8395C               **  STEP 90--  **
8396C               **  EXIT       **
8397C               *****************
8398C
8399 9000 CONTINUE
8400      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRPH')THEN
8401        WRITE(ICOUT,999)
8402        CALL DPWRST('XXX','BUG ')
8403        WRITE(ICOUT,9011)
8404 9011   FORMAT('***** AT THE END       OF GRDRPH--')
8405        CALL DPWRST('XXX','BUG ')
8406        WRITE(ICOUT,9012)NP,IGUNIT,JPATT,JFONT,JCASE,JJUST
8407 9012   FORMAT('NP,IGUNIT,JPATT,JFONT,JCASE,JJUST = ',6I8)
8408        CALL DPWRST('XXX','BUG ')
8409        WRITE(ICOUT,9013)IMANUF,IFIG,IPATT,IFONT,ICASE,IJUST
8410 9013   FORMAT('IMANUF,IFIG,IPATT,IFONT,ICASE,IJUST = ',5(A4,2X),A4)
8411        CALL DPWRST('XXX','BUG ')
8412        DO9015I=1,NP
8413          WRITE(ICOUT,9016)PX(I),PY(I)
8414 9016     FORMAT('PX(I),PY(I) = ',2G15.7)
8415          CALL DPWRST('XXX','BUG ')
8416 9015   CONTINUE
8417        WRITE(ICOUT,9023)IDIR,ANGLE,JDIR
8418 9023   FORMAT('IDIR,ANGLE,JDIR = ',A4,2X,G15.7,I8)
8419        CALL DPWRST('XXX','BUG ')
8420        WRITE(ICOUT,9026)PTHICK,JTHICK,PTHIC2
8421 9026   FORMAT('PTHICK,JTHICK,PTHIC2 = ',G15.7,I8,G15.7)
8422        CALL DPWRST('XXX','BUG ')
8423        WRITE(ICOUT,9027)PHEIGH,PWIDTH,PVEGAP,PHOGAP
8424 9027   FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4G15.7)
8425        CALL DPWRST('XXX','BUG ')
8426        WRITE(ICOUT,9028)PHEIG2,PWIDT2,PVEGA2,PHOGA2
8427 9028   FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4G15.7)
8428        CALL DPWRST('XXX','BUG ')
8429        WRITE(ICOUT,9030)PXINC,PYINC,PXDEL,PYDEL
8430 9030   FORMAT('PXINC,PYINC,PXDEL,PYDEL = ',4G15.7)
8431        CALL DPWRST('XXX','BUG ')
8432        WRITE(ICOUT,9031)ISYMBL,ISPAC,ICOL,JCOL,NCSTR
8433 9031   FORMAT('ISYMBL,ISPAC,ICOL,JCOL,NCSTR = ',3(A4,2X),2I8)
8434        CALL DPWRST('XXX','BUG ')
8435        WRITE(ICOUT,9033)IERRG4,IC4,IC,IC1,IC2
8436 9033   FORMAT('IERRG4,IC4,IC,IC1,IC2 = ',A4,2X,A4,3(2X,A1))
8437        CALL DPWRST('XXX','BUG ')
8438        IF(NCSTR.GT.0)THEN
8439          DO9045I=1,NCSTR
8440            CALL DPCOAN(ICSTR(I:I),IASCNE)
8441            WRITE(ICOUT,9046)I,ICSTR(I:I),IASCNE
8442 9046       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
8443            CALL DPWRST('XXX','BUG ')
8444 9045     CONTINUE
8445        ENDIF
8446      ENDIF
8447C
8448      RETURN
8449      END
8450      SUBROUTINE GRDRPL(PX,PY,NP,
8451     1                  IFIG,IPATT,PTHICK,ICOL,
8452     1                  JPATT,JTHICK,PTHIC2,JCOL)
8453C
8454C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE, DRAW THE POLYLINE WHOSE
8455C              COORDINATES ARE GIVEN IN (PX(.),PY(.)).
8456C     NOTE--THE COORDINATES IN (PX(.),PY(.)) ARE IN
8457C           STANDARDIZED (0.0 TO 100.0) UNITS.
8458C     NOTE--THERE ARE NP SUCH COORDINATE PAIRS.
8459C
8460C     WRITTEN BY--JAMES J. FILLIBEN
8461C                 STATISTICAL ENGINEERING DIVISION
8462C                 INFORMATION TECHNOLOGY LABORATORY
8463C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
8464C                 GAITHERSBURG, MD 20899-8980
8465C                 PHONE--301-975-2855
8466C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
8467C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
8468C     LANGUAGE--ANSI FORTRAN (1977)
8469C     VERSION NUMBER--83.6
8470C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
8471C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
8472C                                      DRIVER OBSOLETE
8473C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
8474C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
8475C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
8476C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
8477C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
8478C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
8479C     UPDATED         --MAY      1990. PACK HP-GL OUTPUT (BY ALAN HECKERT)
8480C     UPDATED         --JUNE     1990. TEMPORARY ARRAYS TO GARBAGE COMMON
8481C     UPDATED         --JULY     1990. PACK HP-2622 COORDINATES
8482C     UPDATED         --AUGUST   1990. BUG FIX IN POSTSCRIPT
8483C     UPDATED         --SEPTEMBER1990. BUG FIX IN SUN
8484C     UPDATED         --MARCH    1991. PACK REGIS OUTPUT
8485C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
8486C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
8487C                                      DRIVER OBSOLETE
8488C     UPDATED         --SEPTEMBER 1995. VGA/TURBOC MULTIPLOTTING
8489C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
8490C                                      OLD CALCOMP STYLE
8491C                                      DRIVER OBSOLETE
8492C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
8493C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
8494C                                      USE BILL MITCHELLS OPENGL
8495C                                      BINDING FOR FORTRAN
8496C     UPDATED         --OCTOBER  1996. GKS (ALAN)
8497C                                      CODED, NOT TESTED
8498C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
8499C                                      PLACEHOLDER FOR NOW
8500C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
8501C                                      PLACEHOLDER FOR NOW
8502C     UPDATED         --OCTOBER  1996. FIX BLANK LINE FOR SOME DEVICES
8503C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
8504C     UPDATED         --DECEMBER 1997. UPDATE TO GENERAL CODED FOR
8505C                                      GUI.
8506C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
8507C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
8508C     UPDATED         --JUNE     2000. MACINTOSH
8509C                                      PLACEHOLDER FOR NOW
8510C     UPDATED         --JUNE     2000. PC PRINTER
8511C                                      PLACEHOLDER FOR NOW
8512C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
8513C                                      PLACEHOLDER FORM
8514C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
8515C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
8516C     UPDATED         --FEBRUARY 2006. IMPLEMENT THE LATEX DRIVER
8517C     UPDATED         --APRIL    2009. IMPLEMENT LIBPLOT DRIVER
8518C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
8519C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
8520C     UPDATED         --SEPTEMBER 2015. FIX GREYSCALE COLOR FOR SVG
8521C     UPDATED         --OCTOBER   2016. ADD PRE-PROCESSOR DIRECTIVES
8522C     UPDATED         --OCTOBER   2016. ADD TEMPLATES FOR SEVERAL FUTURE
8523C                                       DEVICES
8524C     UPDATED         --JULY      2019. TWEAK SCRATCH SPACE
8525C
8526C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
8527C
8528#ifdef HAVE_WININTERACTER
8529      USE WINTERACTER
8530#endif
8531#ifdef HAVE_INTERACTER
8532      USE INTERACTER
8533#endif
8534CCCCC ADD FOLLOWING LINES FOR MICROSOFT WINDOWS QUICKWIN DRIVER.  10/96
8535#ifdef HAVE_QWIN
8536CQWIN USE DFLIB
8537      USE IFQWIN
8538CCCCC LOGICAL MODESTATUS
8539      TYPE (WINDOWCONFIG)   DPSCREEN
8540      CHARACTER*4 QWSCRN
8541      COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
8542      TYPE (XYCOORD)   WXY
8543#endif
8544C
8545      INTEGER IGKSID
8546      INTEGER IGKSWK
8547      INTEGER IGKSTY
8548      COMMON/IGKS/IGKSID,IGKSWK,IGKSTY
8549C
8550      CHARACTER*4 IFIG
8551      CHARACTER*4 IPATT
8552      CHARACTER*4 ICOL
8553      CHARACTER*2 ICJUNK
8554C
8555      INCLUDE 'DPCOPA.INC'
8556      DIMENSION PX(*)
8557      DIMENSION PY(*)
8558CCCCC THE FOLLOWING 5 LINES WERE ADDED     SEPTEMBER 1995
8559CCCCC TO SOLVE THE "WANDERING" TIC MARK PROBLEM
8560CCCCC WITH MULTIPLOTTING ON THE PC TURBO-C FRONTEND
8561      DIMENSION PXP(MAXPOP)
8562      DIMENSION PYP(MAXPOP)
8563      INCLUDE 'DPCOZZ.INC'
8564      EQUIVALENCE (GARBAG(IGARG6),PXP(1))
8565      EQUIVALENCE (GARBAG(IGARG9),PYP(1))
8566C
8567      DOUBLE PRECISION DPXP(MAXPOP)
8568      DOUBLE PRECISION DPYP(MAXPOP)
8569      INCLUDE 'DPCOZD.INC'
8570      EQUIVALENCE (DGARBG(IDGAR1),DPXP(1))
8571      EQUIVALENCE (DGARBG(IDGAR6),DPYP(1))
8572C
8573C  FOLLOWING DIMENSION STATEMENT FOR THE SUN CASE
8574      DIMENSION IPX(MAXPOP)
8575      DIMENSION IPY(MAXPOP)
8576CCCCC FOLLOWING LINES ADDED JUNE, 1990
8577      INCLUDE 'DPCOZI.INC'
8578      EQUIVALENCE (IGARBG(IIGAR1),IPX(1))
8579      EQUIVALENCE (IGARBG(IIGAR5),IPY(1))
8580CCCCC END CHANGE
8581C
8582      CHARACTER*130 ICSTR
8583      CHARACTER*4 ISUBN0
8584      CHARACTER*1 ICARAT
8585      CHARACTER*1 IQUOTE
8586C
8587C-----COMMON----------------------------------------------------------
8588C
8589      INCLUDE 'DPCOGR.INC'
8590      INCLUDE 'DPCONP.INC'
8591      INCLUDE 'DPCOBE.INC'
8592      INCLUDE 'DPCODV.INC'
8593      INCLUDE 'DPCOST.INC'
8594      INCLUDE 'DPCOF2.INC'
8595CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE
8596      PARAMETER(MAXCLR=89)
8597      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
8598C
8599CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE
8600      INCLUDE 'DPCOCT.INC'
8601      INCLUDE 'DPCOP2.INC'
8602C
8603C-----START POINT-----------------------------------------------------
8604C
8605      ISUBN0='DRPL'
8606      IERRG4='NO'
8607C
8608      NCSTR=(-999)
8609      ISAVE=(-999)
8610      NLOOP=0
8611      DEL=0.0
8612      AI=0.0
8613C
8614      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'DRPL')THEN
8615        WRITE(ICOUT,999)
8616  999   FORMAT(1X)
8617        CALL DPWRST('XXX','BUG ')
8618        WRITE(ICOUT,51)
8619   51   FORMAT('***** AT THE BEGINNING OF GRDRPL--')
8620        CALL DPWRST('XXX','BUG ')
8621        WRITE(ICOUT,52)IGUNIT,NP,IFIG,IPATT,JPATT
8622   52   FORMAT('IGUNIT,NP,IFIG,IPATT,JPATT = ',2I8,3(2X,A4))
8623        CALL DPWRST('XXX','BUG ')
8624        DO55I=1,NP
8625          WRITE(ICOUT,56)PX(I),PY(I)
8626   56     FORMAT('PX(I),PY(I) = ',2G15.7)
8627          CALL DPWRST('XXX','BUG ')
8628   55   CONTINUE
8629        WRITE(ICOUT,60)PTHICK,JTHICK,PTHIC2
8630   60   FORMAT('PTHICK,JTHICK,PTHIC2 = ',G15.7,I8,G15.7)
8631        CALL DPWRST('XXX','BUG ')
8632        WRITE(ICOUT,61)ICOL,IMANUF,IMODEL,JCOL
8633   61   FORMAT('ICOL,IMANUF,IMODEL,JCOL = ',3(A4,2X),I8)
8634        CALL DPWRST('XXX','BUG ')
8635        WRITE(ICOUT,69)IBUGG4,ISUBG4,IERRG4
8636   69   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',2(A4,2X),A4)
8637        CALL DPWRST('XXX','BUG ')
8638      ENDIF
8639C
8640C               ********************************************
8641C               **  STEP 1--                              **
8642C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
8643C               **  AND THE MODEL                         **
8644C               ********************************************
8645C
8646      IF(IMANUF.EQ.'QWIN')THEN
8647        GOTO4700
8648      ELSEIF(IMANUF.EQ.'POST')THEN
8649        GOTO8600
8650      ELSEIF(IMANUF.EQ.'X11 ')THEN
8651        GOTO9600
8652      ELSEIF(IMANUF.EQ.'AQUA')THEN
8653        GOTO13500
8654      ELSEIF(IMANUF.EQ.'GENE')THEN
8655        IF(IMODEL.EQ.'CODE')GOTO3200
8656        IF(IMODEL.EQ.'CGM')GOTO3300
8657        IF(IMODEL.EQ.'CGMB')GOTO3400
8658        GOTO3100
8659      ELSEIF(IMANUF.EQ.'SVG ')THEN
8660        GOTO16000
8661      ELSEIF(IMANUF.EQ.'GD  ')THEN
8662        GOTO12000
8663      ELSEIF(IMANUF.EQ.'LATE')THEN
8664        GOTO15000
8665      ELSEIF(IMANUF.EQ.'CAIR')THEN
8666        GOTO17000
8667      ELSEIF(IMANUF.EQ.'D3  ')THEN
8668        GOTO19000
8669      ELSEIF(IMANUF.EQ.'WMF ')THEN
8670        GOTO18000
8671      ELSEIF(IMANUF.EQ.'OPGL')THEN
8672        GOTO4800
8673      ELSEIF(IMANUF.EQ.'TEKT')THEN
8674        IF(IMODEL.EQ.'4027')GOTO1200
8675        GOTO1100
8676      ELSEIF(IMANUF.EQ.'HP')THEN
8677        IF(IMODEL.EQ.'7221')GOTO2100
8678        IF(IMODEL.EQ.'2622')GOTO2300
8679        IF(IMODEL.EQ.'2623')GOTO2300
8680        IF(IMODEL.EQ.'2627')GOTO2300
8681        IF(IMODEL.EQ.'2647')GOTO2300
8682        GOTO2200
8683      ELSEIF(IMANUF.EQ.'LIBP')THEN
8684        GOTO2600
8685      ELSEIF(IMANUF.EQ.'REGI')THEN
8686        GOTO8100
8687      ELSEIF(IMANUF.EQ.'GKS ')THEN
8688        GOTO11000
8689      ELSEIF(IMANUF.EQ.'LAHE')THEN
8690        IF(IMODEL.EQ.'INTE')GOTO4900
8691        IF(IMODEL.EQ.'WINT')GOTO4950
8692        GOTO4600
8693      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
8694        GOTO13000
8695      ELSEIF(IMANUF.EQ.'QUIC')THEN
8696        GOTO9100
8697      ELSEIF(IMANUF.EQ.'CALC')THEN
8698        GOTO4100
8699      ELSEIF(IMANUF.EQ.'ZETA')THEN
8700        GOTO5100
8701      ELSEIF(IMANUF.EQ.'TURB')THEN
8702        GOTO10000
8703      ELSEIF(IMANUF.EQ.'SUN ')THEN
8704        GOTO6600
8705      ENDIF
8706      GOTO9000
8707C
8708C               **************************************************************
8709C               **  STEP 11--                                               **
8710C               **  TREAT THE TEKTRONIX 400X, 401X, 405X, AND 4114 CASES    **
8711C               **  (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES)        **
8712C               **  TO DRAW A POLYLINE,  DO THE FOLLOWING--
8713C               **  STEP 1--SET THE MODE AS GRAPHICS MODE                   **
8714C               **         (AS OPPOSED TO ALPHANUMERIC MODE)                **
8715C               **  STEP 2--TRANSLATE THE COORDINATES FOR THE START POINT.  **
8716C               **          THE ORDER IS HIY, LSBYX, LOY, HIX, LOX          **
8717C               **  STEP 3--TRANSLATE THE COORDINATES FOR THE STOP POINT.   **
8718C               **          THE ORDER IS HIY, LSBYX, LOY, HIX, LOX          **
8719C               **  STEP 4--WRITE OUT THE MODE PLUS (ON THE SAME LINE)      **
8720C               **          THE 2 TRANSLATED PAIRS OF COORDINATE POINTS.    **
8721C               **  REFERENCE--XXX                                          **
8722C               **************************************************************
8723C
8724 1100 CONTINUE
8725      IFACTO=4
8726CCCCC IF(NUMHPP.GE.4000)IFACTO=1
8727CCCCC FOLLOWING LINE MODIFIED MARCH, 1990 (TO ALLOW PORT, SQUARE ORIENT)
8728      IF(NUMVPP.GE.3000)IFACTO=1
8729      IF(NP.LE.0 .OR. JPATT.EQ.-1)GOTO9000
8730C
8731      IF(IMODEL.EQ.'4006'.OR.IMODEL.EQ.'4010')THEN
8732        ICSTR(1:1)=IGSC
8733        NCSTR=1
8734        ISAVE=NCSTR
8735      ELSE
8736        ICSTR(1:1)=IESCC
8737        CALL DPCONA(JPATT,ICSTR(2:2))
8738        ICSTR(3:3)=IGSC
8739        NCSTR=3
8740        ISAVE=NCSTR
8741      ENDIF
8742C
8743      I=0
8744      I=I+1
8745C
8746 1110 CONTINUE
8747      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
8748      CALL TKTRPT(IX,IY,IFACTO,ICSTR,NCSTR,ISUBN0)
8749C
8750 1120 CONTINUE
8751      I=I+1
8752      IF(I.GT.NP)THEN
8753        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8754      ELSE
8755        CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
8756        CALL TKTRPT(IX,IY,IFACTO,ICSTR,NCSTR,ISUBN0)
8757C
8758        IF(NCSTR.GE.70)THEN
8759          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8760          NCSTR=ISAVE
8761          GOTO1110
8762        ELSE
8763          GOTO1120
8764        ENDIF
8765      ENDIF
8766C
8767      GOTO9000
8768C
8769C               ******************************************************
8770C               **  STEP 12--                                       **
8771C               **  TREAT THE TEKTRONIX 4027 CASE                   **
8772C               **  (COLOR RASTER DEVICE).                          **
8773C               **  TO DRAW A POLYLINE,  DO THE FOLLOWING--         **
8774C               **  STEP 1--SET THE MODE AS GRAPHICS MODE           **
8775C               **         (AS OPPOSED TO ALPHANUMERIC MODE)        **
8776C               **  STEP 2--TRANSLATE THE COORDINATES FOR THE       **
8777C               **          START POINT.                            **
8778C               **          THE ORDER IS HIY, LSBYX, LOY, HIX, LOX  **
8779C               **  STEP 3--TRANSLATE THE COORDINATES FOR THE       **
8780C               **          STOP POINT.                             **
8781C               **          THE ORDER IS HIY, LSBYX, LOY, HIX, LOX  **
8782C               **  STEP 4--WRITE OUT THE MODE PLUS (ON THE SAME LIN**
8783C               **          THE 2 TRANSLATED PAIRS OF COORDINATE POI**
8784C               **  REFERENCE--XXX                                  **
8785C               ******************************************************
8786C
8787 1200 CONTINUE
8788      NPM1=NP-1
8789      IF(NPM1.LE.0 .OR. JPATT.EQ.-1)GOTO9000
8790      I=0
8791      IP1=I+1
8792      CALL GRTRSD(PX(IP1),PY(IP1),IX2,IY2,ISUBN0)
8793      DO1210I=1,NPM1
8794        IP1=I+1
8795        IX1=IX2
8796        IY1=IY2
8797        IP1=I+1
8798        CALL GRTRSD(PX(IP1),PY(IP1),IX2,IY2,ISUBN0)
8799        ICSTR(1:5)='!VEC '
8800        NCSTR=5
8801        NCHTOT=8
8802        CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
8803        CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
8804        CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
8805        CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR)
8806        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8807 1210 CONTINUE
8808C
8809      GOTO9000
8810C
8811C               ******************************************************
8812C               **  STEP 21--                                       **
8813C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
8814C               **  (MULTI-COLOR PENPLOTTER)                        **
8815C               **  TO DRAW A POLYLINE--                            **
8816C               **  USE THE LOWER CASE P (= MOVE) INSTRUCTION       **
8817C               **  AND PACKED BINARY COORDINATES,                  **
8818C               **  AND THE LOWER CASE Q (= DRAW) INSTRUCTION       **
8819C               **  AND PACKED BINARY COORDINATES,                  **
8820C               **  (WITH TRAILING RIGHT CURLY BRACKET WHICH ARE THE**
8821C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
8822C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
8823C               **             OPERATING AND PROGRAMMING MANUAL,    **
8824C               **             PAGE 80-85, 253-254.                 **
8825C               ******************************************************
8826C
8827 2100 CONTINUE
8828      IF(NP.LE.0)GOTO9000
8829      I=1
8830      ICSTR(1:1)='p'
8831      NCSTR=1
8832      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
8833      CALL HPTRPT(IX,IY,ICSTR,NCSTR,ISUBN0)
8834      NCSTR=NCSTR+1
8835      ICSTR(NCSTR:NCSTR)='}'
8836      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8837C
8838      IF(NP.GT.1)THEN
8839        DO2120I=2,NP
8840          ICSTR(1:1)='q'
8841          NCSTR=1
8842          CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
8843          CALL HPTRPT(IX,IY,ICSTR,NCSTR,ISUBN0)
8844          NCSTR=NCSTR+1
8845          ICSTR(NCSTR:NCSTR)='}'
8846          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8847 2120   CONTINUE
8848      ENDIF
8849C
8850      GOTO9000
8851C
8852C               ******************************************************
8853C               **  STEP 22--                                       **
8854C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
8855C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
8856C               **  (MULTI-COLOR PENPLOTTERS)                       **
8857C               **  TO DRAW A POLYLINE--                            **
8858C               **  USE THE PU (= PEN UP) INSTRUCTION               **
8859C               **  AND THE PA (= PLOT ABSOLUTE) INSTRUCTION        **
8860C               **  ALONG WITH INTEGER COORDINATES,                 **
8861C               **  AND THE PD (= PEN DOWN) INSTRUCTION             **
8862C               **  AND THE PA (= PLOT ABSOLUTE) INSTRUCTION        **
8863C               **  ALONG WITH INTEGER COORDINATES,                 **
8864C               **  (WITH   TRAILING SEMI-COLONS WHICH ARE THE      **
8865C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
8866C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
8867C               **             OPERATING AND PROGRAMMING MANUAL,    **
8868C               **             PAGE 62, 143.                        **
8869C               **             PAGE 65-67, 143.                     **
8870C               ******************************************************
8871C
8872C  MODIFIED MAY, 1990 (PACK THE OUTPOUT FOR A SMALLER FILE)
8873 2200 CONTINUE
8874CCCCC IF(NP.LE.0)GOTO2290
8875      IF(NP.LE.1)GOTO9000
8876C
8877      I=1
8878      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
8879      ICSTR(1:5)='PU;PA'
8880      NCSTR=5
8881      NCHTOT=5
8882      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
8883      ICSTR(11:11)=','
8884      NCSTR=11
8885      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
8886      ICSTR(17:17)=';'
8887      NCSTR=17
8888      ICSTR(18:20)='PD;'
8889      NCSTR=20
8890      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8891C
8892      ICSTR(1:2)='PA'
8893      NCSTR=2
8894      NCHTOT=5
8895      DO2220I=2,NP
8896        CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
8897        IF(NCSTR.LE.65)THEN
8898          IF(I.GT.2)THEN
8899            NCSTR=NCSTR+1
8900            ICSTR(NCSTR:NCSTR)=','
8901          ENDIF
8902        ELSE
8903          NCSTR=NCSTR+1
8904          ICSTR(NCSTR:NCSTR)=';'
8905          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8906          NCSTR=2
8907        ENDIF
8908        CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
8909        NCSTR=NCSTR+1
8910        ICSTR(NCSTR:NCSTR)=','
8911        CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
8912 2220 CONTINUE
8913C
8914      IF(NCSTR.GT.2)THEN
8915        NCSTR=NCSTR+1
8916        ICSTR(NCSTR:NCSTR)=';'
8917        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8918      ENDIF
8919C
8920      GOTO9000
8921C
8922C               **********************************************************
8923C               **  STEP 23--                                           **
8924C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
8925C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
8926C               **  (MONOCHROME DISPLAY TERMINALS)                      **
8927C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
8928C               **             REFERENCE MANUAL,                        **
8929C               **             PAGE 10-12, 10-13.                       **
8930C               **********************************************************
8931C
8932CCCCC JULY, 1990.  PACK COORDINATES (AT REQUEST OF MIKE KELLY TO SPEED HIS
8933CCCCC EMULATOR PACKAGE).   NOTE THAT WHEN THE COORDINATES ARE PACKED, SOME
8934CCCCC CODES DO NOT NEED TO BE REPEATED.
8935 2300 CONTINUE
8936      IF(NP.LE.1)GOTO9000
8937C
8938      I=1
8939      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
8940      ICSTR(1:1)=IESCC
8941      ICSTR(2:4)='*pa'
8942      NCSTR=4
8943      NCHTOT=5
8944      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
8945      ICSTR(10:10)=','
8946      NCSTR=10
8947      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
8948C
8949      DO2320I=2,NP
8950        IF(NCSTR.GT.112)THEN
8951          NCSTR=NCSTR+1
8952          ICSTR(NCSTR:NCSTR)='Z'
8953          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8954          ICSTR(1:1)=IESCC
8955          ICSTR(2:3)='*p'
8956          NCSTR=3
8957        ENDIF
8958        CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
8959        NCSTR=NCSTR+1
8960        ICSTR(NCSTR:NCSTR)='b'
8961        NCHTOT=5
8962        CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
8963        NCSTR=NCSTR+1
8964        ICSTR(NCSTR:NCSTR)=','
8965        CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
8966 2320 CONTINUE
8967C
8968      IF(NCSTR.GT.3)THEN
8969        NCSTR=NCSTR+1
8970        ICSTR(NCSTR:NCSTR)='Z'
8971        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
8972      ENDIF
8973C
8974      GOTO9000
8975C
8976C               ******************************************************
8977C               **  STEP 26--                                       **
8978C               **  TREAT THE UNIX LIBPLOT                  CASE    **
8979C               ******************************************************
8980C
8981 2600 CONTINUE
8982C
8983      IF(NP.GT.1)THEN
8984        DO2610I=1,NP
8985          DPXP(I)=DBLE(PX(I))
8986          DPYP(I)=DBLE(PY(I))
8987 2610   CONTINUE
8988#ifdef HAVE_LIBPLOT
8989        CALL PLDRAW(DPXP,DPYP,NP)
8990#endif
8991      ENDIF
8992      GOTO9000
8993C
8994C               ******************************************************
8995C               **  STEP 31--                                       **
8996C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
8997C               ******************************************************
8998C
8999 3100 CONTINUE
9000      IF(NP.LE.0)GOTO9000
9001      I=1
9002      ICSTR(1:8)='MOVE TO '
9003      NCSTR=8
9004      NCHTOT=10
9005      NCHDEC=5
9006      CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
9007      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
9008      ICSTR(19:20)='  '
9009      NCSTR=20
9010      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
9011      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9012      IF(NP.LE.1)GOTO9000
9013C
9014      DO3120I=2,NP
9015        ICSTR(1:8)='DRAW TO '
9016        NCSTR=8
9017        NCHTOT=10
9018        NCHDEC=5
9019        CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
9020        CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
9021        ICSTR(19:20)='  '
9022        NCSTR=20
9023        CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
9024        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9025 3120 CONTINUE
9026C
9027      GOTO9000
9028C
9029C               ***************************************************************
9030C               **  STEP 32--                                                **
9031C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
9032C               ***************************************************************
9033C
9034C  DECEMBER 1997.  FOR GUI, CONVERT COORDINATES TO INTEGER (BY
9035C  MULTIPLYING BY 100).  DO NOT PRINT OUT SUCCESSIV POINTS IF THEY
9036C  ARE IDENTICAL.
9037C
9038 3200 CONTINUE
9039      IF(NP.LE.0)GOTO9000
9040      IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')THEN
9041        I=1
9042        ICSTR(1:2)='M '
9043        NCSTR=2
9044        CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
9045        IPXTMP=INT(AX*10.**IGENFA+0.5)
9046        IPYTMP=INT(AY*10.**IGENFA+0.5)
9047        NCHTOT=IGENFA+3
9048        CALL GRTRIN(IPXTMP,NCHTOT,ICSTR,NCSTR)
9049        NCSTR=NCSTR+1
9050        ICSTR(NCSTR:NCSTR)=' '
9051        CALL GRTRIN(IPYTMP,NCHTOT,ICSTR,NCSTR)
9052        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9053        IPXOLD=IPXTMP
9054        IPYOLD=IPYTMP
9055C
9056        IF(NP.LE.1)GOTO9000
9057        DO3270I=2,NP
9058          CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
9059          IPXTMP=INT(AX*10.**IGENFA+0.5)
9060          IPYTMP=INT(AY*10.**IGENFA+0.5)
9061          IF(I.GT.2.AND.IPXTMP.EQ.IPXOLD.AND.IPYTMP.EQ.IPYOLD)GOTO3270
9062          IPXOLD=IPXTMP
9063          IPYOLD=IPYTMP
9064C
9065          ICSTR(1:2)='D '
9066          NCSTR=2
9067          NCHTOT=IGENFA+3
9068          CALL GRTRIN(IPXTMP,NCHTOT,ICSTR,NCSTR)
9069          NCSTR=NCSTR+1
9070          ICSTR(NCSTR:NCSTR)=' '
9071          CALL GRTRIN(IPYTMP,NCHTOT,ICSTR,NCSTR)
9072          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9073 3270   CONTINUE
9074      ELSE
9075        I=1
9076        ICSTR(1:5)='MOTO '
9077        NCSTR=5
9078        NCHTOT=10
9079        NCHDEC=5
9080        CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
9081        CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
9082        ICSTR(16:17)='  '
9083        NCSTR=17
9084        CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
9085        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9086        IF(NP.LE.1)GOTO9000
9087        DO3220I=2,NP
9088          ICSTR(1:5)='DRTO '
9089          NCSTR=5
9090          NCHTOT=10
9091          NCHDEC=5
9092          CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
9093          CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
9094          ICSTR(16:17)='  '
9095          NCSTR=17
9096          CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
9097          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9098 3220   CONTINUE
9099      ENDIF
9100C
9101      GOTO9000
9102C
9103C               ***************************************************************
9104C               **  STEP 33--                                                **
9105C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
9106C               ***************************************************************
9107C
9108 3300 CONTINUE
9109      IF(NP.LE.0)GOTO9000
9110C
9111      I=1
9112      ICSTR(1:6)='LINE '
9113      NCSTR=6
9114      NCHTOT=10
9115      NCHDEC=5
9116      CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
9117      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
9118      ICSTR(17:17)=','
9119      NCSTR=17
9120      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
9121      ICSTR(28:28)=','
9122      NCSTR=28
9123      IF(NP.LE.1)THEN
9124        ICSTR(28:28)=';'
9125        GOTO9000
9126      ENDIF
9127C
9128      DO3320I=2,NP
9129        IF(NCSTR.GT.55)THEN
9130          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9131          NCSTR=0
9132        ENDIF
9133        NCSTR=NCSTR+1
9134        ICSTR(NCSTR:NCSTR)=' '
9135        CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
9136        CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
9137        NCSTR=NCSTR+1
9138        ICSTR(NCSTR:NCSTR)=','
9139        CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
9140        NCSTR=NCSTR+1
9141        ICSTR(NCSTR:NCSTR)=','
9142        IF(I.EQ.NP)ICSTR(NCSTR:NCSTR)=';'
9143 3320 CONTINUE
9144      IF(NCSTR.GT.0)CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9145C
9146      GOTO9000
9147C
9148C               ***************************************************
9149C               **  STEP 34--                                    **
9150C               **  TREAT THE CGM (BINARY)                 CASE  **
9151C               ***************************************************
9152C
9153 3400 CONTINUE
9154      GOTO9000
9155C
9156C               ******************************************************
9157C               **  STEP 41--                                       **
9158C               **  TREAT THE CALCOMP XXXXXX CASE                   **
9159C               **  TO DRAW A POLYLINE--                            **
9160C               **  WRITE OUT AN XXXXXXXXXX                         **
9161C               **  REFERENCE--CALCOMP LIBRARY                      **
9162C               **             XX                                   **
9163C               **             PAGES XX AND XX                      **
9164C               ******************************************************
9165C
9166 4100 CONTINUE
9167      IF(NP.LE.0 .OR. JPATT.EQ.-1)GOTO9000
9168      IF(JPATT.EQ.-1)GOTO9000
9169      I=1
9170C
9171      IPEN=3
9172#ifdef HAVE_CALCOMP
9173      CALL CALCPT(PX(I),PY(I),AX,AY,ISUBN0)
9174      CALL PLOT(AX,AY,IPEN)
9175#endif
9176C
9177      IF(NP.GT.1)THEN
9178        DO4120I=2,NP
9179          IPEN=2
9180#ifdef HAVE_CALCOMP
9181          CALL CALCPT(PX(I),PY(I),AX,AY,ISUBN0)
9182          CALL PLOT(AX,AY,IPEN)
9183#endif
9184 4120   CONTINUE
9185      ENDIF
9186C
9187      GOTO9000
9188C
9189C               ******************************************************
9190C               **  STEP 46--                                       **
9191C               **  TREAT THE LAHEY   XXXXXX CASE                   **
9192C               **  REFERENCE--Programmer's Reference, Revision C   **
9193C               **             Lahey Computer Systems, January, 1992**
9194C               **             PAGES 51 THRU 65                     **
9195C               ******************************************************
9196C
9197 4600 CONTINUE
9198#ifdef HAVE_LAHEY_CALCOMP
9199      IF(NP.LE.0 .OR. JPATT.EQ.-1)GOTO9000
9200      I=1
9201C
9202      IPEN=3
9203      CALL CALCPT(PX(I),PY(I),AX,AY,ISUBN0)
9204      CALL PLOT(AX,AY,IPEN)
9205C
9206      IF(NP.GT.1)THEN
9207        DO4620I=2,NP
9208          IPEN=2
9209          CALL CALCPT(PX(I),PY(I),AX,AY,ISUBN0)
9210          CALL PLOT(AX,AY,IPEN)
9211 4620   CONTINUE
9212      ENDIF
9213#endif
9214C
9215      GOTO9000
9216C
9217C               ******************************************************
9218C               **  STEP 47--                                       **
9219C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
9220C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
9221C               ******************************************************
9222C
9223 4700 CONTINUE
9224      IF(NP.LE.0 .OR. JPATT.EQ.0)GOTO9000
9225      I=1
9226C
9227      PYTEMP=PY(I)
9228      CALL GRTRSD(PX(I),PYTEMP,IX,IY,ISUBN0)
9229#ifdef HAVE_QWIN
9230      CALL MOVETO(INT2(IX),INT2(IY),WXY)
9231#endif
9232C
9233      DO4720I=2,NP
9234        PYTEMP=PY(I)
9235        CALL GRTRSD(PX(I),PYTEMP,IX,IY,ISUBN0)
9236#ifdef HAVE_QWIN
9237        ISTATUS=LINETO(INT2(IX),INT2(IY))
9238#endif
9239 4720 CONTINUE
9240C
9241      GOTO9000
9242C
9243C               ******************************************************
9244C               **  STEP 48--                                       **
9245C               **  TREAT THE OPEN-GL DRIVER                        **
9246C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
9247C               ******************************************************
9248C
9249 4800 CONTINUE
9250      IF(NP.LE.1 .OR. JPATT.EQ.-1)GOTO9000
9251C
9252      DO4810I=1,NP
9253        PXP(I)=PX(I)
9254        PYP(I)=PY(I)
9255 4810 CONTINUE
9256#ifdef HAVE_OPEN_GL
9257      CALL GLDRAW(PXP,PYP,NP)
9258#endif
9259C
9260      GOTO9000
9261C
9262C               ******************************************************
9263C               **  STEP 49--                                       **
9264C               **  TREAT THE LAHEY INTERACTOR CASE                 **
9265C               ******************************************************
9266C
9267 4900 CONTINUE
9268      IF(NP.LE.0 .OR. JPATT.EQ.0)GOTO9000
9269      I=1
9270C
9271      PYTEMP=PY(I)
9272      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
9273#ifdef HAVE_INTERACTER
9274      CALL IGrMoveTo(REAL(IX),REAL(IY))
9275#endif
9276C
9277      DO4920I=2,NP
9278        CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
9279#ifdef HAVE_INTERACTER
9280        CALL IGrLineTo(REAL(IX),REAL(IY))
9281#endif
9282 4920 CONTINUE
9283C
9284      GOTO9000
9285C
9286C               ******************************************************
9287C               **  STEP 49b-                                       **
9288C               **  TREAT THE LAHEY WINTERACTOR CASE                **
9289C               ******************************************************
9290C
9291 4950 CONTINUE
9292      IF(NP.LE.0 .OR. JPATT.EQ.0)GOTO9000
9293      I=1
9294C
9295      PYTEMP=PY(I)
9296#ifdef HAVE_WININTERACTER
9297      CALL IGrMoveTo(PX(I),PY(I))
9298#endif
9299C
9300      DO4970I=2,NP
9301#ifdef HAVE_WININTERACTER
9302        CALL IGrLineTo(PX(I),PY(I))
9303#endif
9304 4970 CONTINUE
9305C
9306      GOTO9000
9307C
9308C
9309C               ******************************************************
9310C               **  STEP 51--                                       **
9311C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
9312C               **  TO DRAW A POLYLINE--                            **
9313C               **  WRITE OUT    ZZZZZZZZZZ                         **
9314C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
9315C               **             MODELS 3600SX AND 3653SX             **
9316C               **             PAGES B-0 AND B-1                    **
9317C               **  USE THE CALCOMP LIBRARY ROUTINES                **
9318C               **  PLOT USED TO DRAW LINES                         **
9319C               **  VALUE OF IPEN DETERMINES DASH PATTERN           **
9320C               **  REFERENCE: FUNDAMENTAL PLOTTING SUBROUTINES,    **
9321C               **             FORTRAN, NICOLET-ZETA, 1984          **
9322C               **  PAGES: 2-2, 3-8, 3-9                            **
9323C               ******************************************************
9324C
9325 5100 CONTINUE
9326      IF(NP.LE.0 .OR. JPATT.EQ.-1)GOTO9000
9327      I=1
9328C
9329      IPEN=3
9330#ifdef HAVE_ZETA
9331      CALL CALCPT(PX(I),PY(I),AX,AY,ISUBN0)
9332      CALL PLOT(AX,AY,IPEN)
9333#endif
9334C
9335      IF(NP.GT.1)THEN
9336        IPEN=2
9337        IF(JPATT.GT.0)IPEN=13+JPATT
9338        IF(IPEN.NE.2 .AND. (IPEN.LT.14.OR.IPEN.GT.19))IPEN=2
9339        DO5120I=2,NP
9340#ifdef HAVE_ZETA
9341          CALL CALCPT(PX(I),PY(I),AX,AY,ISUBN0)
9342          CALL PLOT(AX,AY,IPEN)
9343#endif
9344 5120   CONTINUE
9345      ENDIF
9346      GOTO9000
9347C
9348C               ******************************************************
9349C               **  STEP 66--                                       **
9350C               **  TREAT THE SUN CASE - WRITTEN BY BILL ANDERSON   **
9351C               ******************************************************
9352C
9353C  SEPTEMBER, 1990.  ONLY PLOT 1,000 POINTS AT A TIME.
9354C  GOT AN ERROR MESSAGE ("TOO MANY POINTS") WHEN TRIED TO DO MORE.
9355C
9356 6600 CONTINUE
9357      IF (NP.EQ.1 .OR. JPATT.EQ.-1)GOTO 9000
9358      NLOOPS=(NP-1)/1000+1
9359      DO 6605 K=1,NLOOPS
9360        ISTRT=(K-1)*1000+1
9361        ILAST=K*1000+1
9362        IF(ILAST.GT.NP)ILAST=NP
9363        IF(ILAST.LE.ISTRT)ISTRT=ISTRT-1
9364        JCOUNT=0
9365        DO 6610 IDUMMY=ISTRT,ILAST
9366          JCOUNT=JCOUNT+1
9367          I = IDUMMY
9368          CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
9369          IPX(JCOUNT) = IX
9370          IPY(JCOUNT) = IY
9371 6610   CONTINUE
9372#ifdef HAVE_SUN
9373        CALL cfpolyline(IPX,IPY,JCOUNT)
9374#endif
9375 6605 CONTINUE
9376      GOTO9000
9377C
9378C               ******************************************************
9379C               **  STEP 81--                                       **
9380C               **  TREAT THE DEC  REGIS CASE                       **
9381C               **  TO DRAW A POLYLINE--                            **
9382C               **  USE THE P[  (= POSITION) INSTRUCTION            **
9383C               **  ALONG WITH INTEGER COORDINATES,                 **
9384C               **  AND THE V[ (= VECTOR) INSTRUCTION               **
9385C               **  ALONG WITH INTEGER COORDINATES,                 **
9386C               **  WITH   TRAILING ]                               **
9387C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
9388C               **             PAGES 106 AND 100                    **
9389C               ******************************************************
9390C
9391C  MARCH, 1991.  PACK REGIS OUTPUT.
9392 8100 CONTINUE
9393      NCSTR=0
9394      IF(NP.LE.0)GOTO9000
9395C
9396      MAXREG=130
9397      I=1
9398      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
9399      ICSTR(1:2)='P['
9400      NCSTR=2
9401      NCHTOT=5
9402      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
9403      ICSTR(8:8)=','
9404      NCSTR=8
9405      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
9406      ICSTR(14:14)=']'
9407      NCSTR=14
9408      ICSTR(15:17)='V[]'
9409      NCSTR=17
9410C
9411      IF(NP.LE.1)GOTO9000
9412      DO8120I=2,NP
9413C
9414        IF(NCSTR.GT.MAXREG-15)THEN
9415          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9416          NCSTR=0
9417        END IF
9418C
9419        CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
9420        NCSTR=NCSTR+1
9421        NCSTR2=NCSTR+1
9422        ICSTR(NCSTR:NCSTR2)='V['
9423        NCSTR=NCSTR2
9424        CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
9425        NCSTR=NCSTR+1
9426        ICSTR(NCSTR:NCSTR)=','
9427        CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
9428        NCSTR=NCSTR+1
9429        ICSTR(NCSTR:NCSTR)=']'
9430C
9431 8120 CONTINUE
9432C
9433      IF(NCSTR.GT.0)CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9434      GOTO9000
9435C
9436C               ******************************************************
9437C               **  STEP 86--                                       **
9438C               **  TREAT THE POSTSCRIPT CASE                       **
9439C               **    NEW PATH                                      **
9440C               **    XCOOR YCOOR MOVETO                            **
9441C               **    %LOOP                                         **
9442C               **    XCOOR YCOOR LINETO                            **
9443C               **    %END LOOP                                     **
9444C               **    STROKE                                        **
9445C               **  REFERENCE--POSTSCRIPT LANGUAGE TUTORIAL AND     **
9446C               **             COOKBOOK, ADOBE SYSTEMS              **
9447C               ******************************************************
9448C
9449CCCCC JUNE, 1990.  IF "BLANK" LINE PATTERN, THEN SKIP.
9450 8600 CONTINUE
9451      IF(NP.LE.0 .OR. JPATT.EQ.0)GOTO9000
9452      I=1
9453C
9454      ICSTR(1:8)='newpath '
9455      NCSTR=8
9456      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
9457      NCHTOT=5
9458      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
9459      ICSTR(14:14)=' '
9460      NCSTR=14
9461      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
9462      ICSTR(20:22)=' m '
9463      NCSTR=22
9464      IF(NP.LE.1)GOTO8650
9465C
9466CCCCC FOLLOWING LINE ADDED AUGUST, 1990.
9467      MAXPSP=200
9468      DO8620I=2,NP
9469CCCCC   FOLLOWING LINES ADDED AUGUST 1990.
9470CCCCC   SOME POSTSCRIPT PRINTERS SEEMED TO CHOKE IF TOO MANY LINES DRAWN
9471CCCCC   ON SAME PATH, SO SET AN UPPER LIMIT.
9472        IF(MOD(I,MAXPSP).EQ.0)THEN
9473          IF(NCSTR.GT.110)THEN
9474            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9475            NCSTR=0
9476          ENDIF
9477          NCSTR=NCSTR+1
9478          NCSTR2=NCSTR+14
9479          ICSTR(NCSTR:NCSTR2)='stroke newpath '
9480          NCSTR=NCSTR2
9481          IPREV=I-1
9482          CALL GRTRSD(PX(IPREV),PY(IPREV),IX,IY,ISUBN0)
9483          CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
9484          NCSTR=NCSTR+1
9485          ICSTR(NCSTR:NCSTR)=' '
9486          CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
9487          NCSTR=NCSTR+1
9488          NCSTR2=NCSTR+2
9489          ICSTR(NCSTR:NCSTR2)=' m '
9490          NCSTR=NCSTR2
9491        ENDIF
9492CCCCC   END AUGUST, 1990 CHANGE.
9493        IF(NCSTR.GT.110)THEN
9494          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9495          NCSTR=0
9496        ENDIF
9497C
9498        CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
9499        NCHTOT=5
9500        CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
9501        NCSTR=NCSTR+1
9502        ICSTR(NCSTR:NCSTR)=' '
9503        CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
9504        NCSTR=NCSTR+1
9505        NCSTR2=NCSTR+2
9506        ICSTR(NCSTR:NCSTR2)=' l '
9507        NCSTR=NCSTR2
9508 8620 CONTINUE
9509C
9510 8650 CONTINUE
9511      NCSTR=NCSTR+1
9512      NCSTR2=NCSTR+5
9513      ICSTR(NCSTR:NCSTR2)='stroke'
9514      NCSTR=NCSTR2
9515      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9516      GOTO9000
9517C
9518C               ******************************************************
9519C               **  STEP 91--                                       **
9520C               **  TREAT THE QUIC LANDSCAPE CASE                   **
9521C               **  <ICARAT>IGV       - ENABLE VECTOR GRAPHICS MODE **
9522C               **  <ICARAT>Wtttttbbbbblllllrrrrr - SET PAGE MARGINS**
9523C               **  NOTE: ENFORCE MARGIN WITH THE "OFFSET" AND NUMBER*
9524C               **        OF PICTURE POINTS.  WE ONLY WANT TO CLIP  **
9525C               **        AT THE MARGIN, NOT FORCE A PAGE ERASE.    **
9526C               **  <ICARAT>Tttttt    - SET Y ORGIN FROM TOP OF PAGE**
9527C               **  <ICARAT>Jjjjjj    - SET X ORGIN FROM LEFT       **
9528C               **  <ICARAT>PWnn      - SET PEN WIDTH (3 CLOSEST TO **
9529C               **                      0.1 DATAPLOT UNITS)         **
9530C               **  <ICARAT>Vp        - SELECT LINE PATTERN         **
9531C               **  <ICARAT>UXXXXX:YYYYY - MOVE                     **
9532C               **  <ICARAT>DXXXXX:YYYYY - DRAW                     **
9533C               **  REFERENCE: QUIC PROGRAMMERS MANUAL - CHAPTER 14 **
9534C               **          ON VECTOR GRAPHICS                      **
9535C               ******************************************************
9536C
9537 9100 CONTINUE
9538      IF(NP.LE.0 .OR. JPATT.EQ.-1)GOTO9000
9539      I=1
9540C
9541      CALL DPCONA(94,ICARAT)
9542      ICSTR(1:1)=ICARAT
9543      ICSTR(2:4)='IGV'
9544      ICSTR(5:5)=ICARAT
9545      ICSTR(6:6)='W'
9546C
9547      IF(IORNSW.EQ.'PORT')THEN
9548        IX2=8500
9549        IY2=11000
9550      ELSE
9551        IX2=11000
9552        IY2=8500
9553      ENDIF
9554C
9555      IX=0
9556      IY=0
9557      NCSTR=6
9558      NCHTOT=-5
9559      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
9560      CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR)
9561      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
9562      CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
9563      ICSTR(27:27)=ICARAT
9564      ICSTR(28:33)='T00000'
9565      ICSTR(34:34)=ICARAT
9566      ICSTR(35:40)='J00000'
9567      ICSTR(41:41)=ICARAT
9568      ICSTR(42:43)='PW'
9569      NCSTR=43
9570      NCHTOT=-2
9571      IJUNK=INT(PTHIC2+0.5)
9572      CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
9573      NCSTR=45
9574      ICSTR(46:46)=ICARAT
9575      ICSTR(47:47)='V'
9576      NCSTR=47
9577      NCHTOT=-1
9578      CALL GRTRIN(JPATT,NCHTOT,ICSTR,NCSTR)
9579      ICSTR(49:49)=ICARAT
9580      ICSTR(50:50)='U'
9581      NCSTR=50
9582C     NOTE: QUIC POSIOTIONS FROM TOP OF PAGE NOT THE BOTTOM, REVERSE Y
9583      PYTEMP=100.-PY(I)
9584      CALL QUICPT(PX(I),PYTEMP,IX,IY,ISUBN0)
9585      NCHTOT=-5
9586      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
9587      ICSTR(56:56)=':'
9588      NCSTR=56
9589      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
9590      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9591      IF(NP.LE.1)GOTO9000
9592C
9593      NCSTR=0
9594      NCHTOT=-5
9595      DO9130I=2,NP
9596        IF(NCSTR.GE.110)THEN
9597          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9598          NCSTR=0
9599        ENDIF
9600        NCSTR=NCSTR+1
9601        ICSTR(NCSTR:NCSTR)=ICARAT
9602        NCSTR=NCSTR+1
9603        ICSTR(NCSTR:NCSTR)='D'
9604        PYTEMP=100.-PY(I)
9605        CALL QUICPT(PX(I),PYTEMP,IX,IY,ISUBN0)
9606        CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
9607        NCSTR=NCSTR+1
9608        ICSTR(NCSTR:NCSTR)=':'
9609        CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
9610 9130 CONTINUE
9611C
9612      NCSTR=NCSTR+1
9613      ICSTR(NCSTR:NCSTR)=ICARAT
9614      NCTMP1=NCSTR+1
9615      NCSTR=NCSTR+3
9616      ICSTR(NCTMP1:NCSTR)='IGE'
9617      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9618C
9619      GOTO9000
9620C
9621C               ******************************************************
9622C               **  STEP 96--                                       **
9623C               **  TREAT THE X11        CASE                       **
9624C               ******************************************************
9625C
9626 9600 CONTINUE
9627#ifdef HAVE_X11
9628      IF(IX11OF.EQ.'OFF' .OR. NP.EQ.1 .OR. JPATT.EQ.-1)GOTO9000
9629      DO9610IDUMMY=1,NP
9630         I = IDUMMY
9631         CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
9632         IPX(IDUMMY) = IX
9633         IPY(IDUMMY) = IY
9634 9610 CONTINUE
9635      CALL XDRAW(IPX,IPY,NP)
9636#endif
9637      GOTO9000
9638C
9639C               *************************************************
9640C               **  STEP 100--                                 **
9641C               **  TREAT THE VGA VIA TURBO-C       CASE       **
9642C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
9643C               **             ENHANCEMENTS, PAGE 69.          **
9644C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
9645C               **             PAGE 98.                        **
9646C               **  REFERENCE--WEISKAMP, POWER GRAPHICS        **
9647C               **             USING TURBO C, PAGE 32-33.      **
9648C               *************************************************
9649C
965010000 CONTINUE
9651      IF(ITCST.EQ.'CLOS' .OR. NP.EQ.1 .OR. JPATT.EQ.-1)GOTO9000
9652      DO10100I=1,NP
9653         PX1P=PX(I)
9654         PY1P=PY(I)
9655         CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
9656         PXP(I)=AX
9657         PYP(I)=AY
965810100 CONTINUE
9659CTURB CALL TCDRPL(PXP,PYP,NP)
9660      GOTO9000
9661C
9662C               ******************************************************
9663C               **  STEP 110--                                      **
9664C               **  TREAT THE GKS                DRIVER             **
9665C               ******************************************************
9666C
966711000 CONTINUE
9668      IF(JPATT.EQ.-1)GOTO9000
9669#ifdef HAVE_GKS
9670      IF(NP.GE.2)THEN
9671        CALL GSLN(1)
9672        DO11010
9673          PXP(I)=PX(I)/100.0
9674          PYP(I)=PY(I)/100.0
9675          CALL GPL(NP, PXP, PYP)
967611010   CONTINUE
9677      ENDIF
9678#endif
9679      GOTO9000
9680C
9681C               ******************************************************
9682C               **  STEP 120--                                      **
9683C               **  TREAT THE GD                     DRIVER         **
9684C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
9685C               **  1) JPEG                                         **
9686C               **  2) PNG                                          **
9687C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
9688C               ******************************************************
9689C
969012000 CONTINUE
9691      IF(NP.LE.1 .OR. JPATT.EQ.-1)GOTO9000
9692C
9693      DO12010I=2,NP
9694        CALL GRTRSD(PX(I-1),PY(I-1),IX1,IY1,ISUBN0)
9695        CALL GRTRSD(PX(I),PY(I),IX2,IY2,ISUBN0)
9696#ifdef HAVE_GD
9697        CALL GDDRAW(IX1,IY1,IX2,IY2,JCOL,JPATT)
9698#endif
969912010 CONTINUE
9700      GOTO9000
9701C
9702C               ******************************************************
9703C               **  STEP 130--                                      **
9704C               **  TREAT THE ABSOFT                 DRIVER         **
9705C               ******************************************************
9706C
970713000 CONTINUE
9708      IF(NP.LE.1 .OR. JPATT.EQ.-1)GOTO9000
9709C
9710#ifdef HAVE_ABSOFT
9711      CALL MovePen(PX(1),PY(1))
9712#endif
9713      DO13010I=2,NP
9714#ifdef HAVE_ABSOFT
9715        CALL MoveDraw(PX(I),PY(I))
9716#endif
971713010 CONTINUE
9718      GOTO9000
9719C
9720C               ******************************************************
9721C               **  STEP 135--                                      **
9722C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
9723C               ******************************************************
9724C
9725C     2014/06: SEND POINTS IN INCREMENTS OF 1,000.
9726C              NOTE THAT IN ORDER FOR LINE TO STAY
9727C              CONNECTED, NEED TO REPEAT LAST POINT
9728C              IN NEXT LOOP ITERATION.
9729C
9730C
973113500 CONTINUE
9732      IF(NP.LE.1 .OR. JPATT.EQ.-1)GOTO9000
9733C
9734      DO13510I=1,NP
9735        CALL GRTRSD(PX(I),PY(I),IX1,IY1,ISUBN0)
9736        PXP(I)=REAL(IX1)
9737        PYP(I)=REAL(IY1)
973813510 CONTINUE
9739COLD  CALL aqtAddPolylineTo(PXP,PYP,NP)
9740      ICAP=1
9741      IF(IAQUCS.EQ.'ROUN')ICAP=2
9742      IF(IAQUCS.EQ.'SQUA')ICAP=3
9743      IF(NP.LE.1000)THEN
9744#ifdef HAVE_AQUA
9745        CALL aqdraw(PXP,PYP,NP,ICAP)
9746#endif
9747      ELSE
9748        NMAXPT=999
9749        NLOOP=NP/NMAXPT
9750        IF(MOD(NP,NMAXPT).GT.0)NLOOP=NLOOP+1
9751        DO13520I=1,NLOOP
9752          ISTRT=(I-1)*NMAXPT + 1
9753          IF(I.GT.1)ISTRT=ISTRT-1
9754          ISTOP=I*NMAXPT
9755          IF(ISTOP.GT.NP)ISTOP=NP
9756          NPTEMP=ISTOP-ISTRT+1
9757#ifdef HAVE_AQUA
9758          CALL aqdraw(PXP(ISTRT),PYP(ISTRT),NPTEMP,ICAP)
9759#endif
976013520   CONTINUE
9761      ENDIF
9762      GOTO9000
9763C
9764C               ******************************************************
9765C               **  STEP 150--                                      **
9766C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
9767C               ******************************************************
9768C
976915000 CONTINUE
9770      IF(NP.LE.1 .OR. JPATT.EQ.-1)GOTO9000
9771      IF(JPATT.EQ.1)THEN
9772        ICSTR(1:1)=IBASLC
9773        ICSTR(2:13)='drawline[ 0]'
9774        NCSTR=13
9775      ELSEIF(JPATT.EQ.3)THEN
9776        ICSTR(1:1)=IBASLC
9777        ICSTR(2:15)='dottedline{12}'
9778        NCSTR=15
9779      ELSEIF(JPATT.EQ.2)THEN
9780        ICSTR(1:1)=IBASLC
9781        ICSTR(2:13)='dashline{24}'
9782        NCSTR=13
9783      ELSEIF(JPATT.EQ.4)THEN
9784        ICSTR(1:1)=IBASLC
9785        ICSTR(2:18)='dashline[-30]{12}'
9786        NCSTR=18
9787      ELSEIF(JPATT.EQ.5)THEN
9788        ICSTR(1:1)=IBASLC
9789        ICSTR(2:18)='dashline[-30]{24}'
9790        NCSTR=18
9791      ELSEIF(JPATT.EQ.6)THEN
9792        ICSTR(1:1)=IBASLC
9793        ICSTR(2:18)='dashline[+30]{12}'
9794        NCSTR=18
9795      ELSEIF(JPATT.EQ.7)THEN
9796        ICSTR(1:1)=IBASLC
9797        ICSTR(2:18)='dashline[+30]{24}'
9798        NCSTR=18
9799      ELSE
9800        ICSTR(1:1)=IBASLC
9801        ICSTR(2:13)='drawline[ 0]'
9802        NCSTR=13
9803      ENDIF
9804C
9805      IPTS=0
9806      NCHTOT=5
9807      DO15010I=1,NP
9808        IPTS=IPTS+1
9809        CALL GRTRSD(PX(I),PY(I),IX1,IY1,ISUBN0)
9810        NCSTR=NCSTR+1
9811        ICSTR(NCSTR:NCSTR)='('
9812        CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
9813        NCSTR=NCSTR+1
9814        ICSTR(NCSTR:NCSTR)=','
9815        CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
9816        NCSTR=NCSTR+1
9817        ICSTR(NCSTR:NCSTR)=')'
9818        IF(NCSTR.GT.80)THEN
9819          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9820          NCSTR=0
9821          IF(JPATT.EQ.1)THEN
9822            ICSTR(1:1)=IBASLC
9823            ICSTR(2:13)='drawline[ 0]'
9824            NCSTR=13
9825          ELSEIF(JPATT.EQ.3)THEN
9826            ICSTR(1:1)=IBASLC
9827            ICSTR(2:15)='dottedline{12}'
9828            NCSTR=15
9829          ELSEIF(JPATT.EQ.2)THEN
9830            ICSTR(1:1)=IBASLC
9831            ICSTR(2:13)='dashline{24}'
9832            NCSTR=13
9833          ELSEIF(JPATT.EQ.4)THEN
9834            ICSTR(1:1)=IBASLC
9835            ICSTR(2:18)='dashline[-30]{12}'
9836            NCSTR=18
9837          ELSEIF(JPATT.EQ.5)THEN
9838            ICSTR(1:1)=IBASLC
9839            ICSTR(2:18)='dashline[-30]{24}'
9840            NCSTR=18
9841          ELSEIF(JPATT.EQ.6)THEN
9842            ICSTR(1:1)=IBASLC
9843            ICSTR(2:18)='dashline[+30]{12}'
9844            NCSTR=18
9845          ELSEIF(JPATT.EQ.7)THEN
9846            ICSTR(1:1)=IBASLC
9847            ICSTR(2:18)='dashline[+30]{24}'
9848            NCSTR=18
9849          ELSE
9850            ICSTR(1:1)=IBASLC
9851            ICSTR(2:13)='drawline[ 0]'
9852            NCSTR=13
9853          ENDIF
9854          IPTS=0
9855          IPTS=IPTS+1
9856          CALL GRTRSD(PX(I),PY(I),IX1,IY1,ISUBN0)
9857          NCSTR=NCSTR+1
9858          ICSTR(NCSTR:NCSTR)='('
9859          CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
9860          NCSTR=NCSTR+1
9861          ICSTR(NCSTR:NCSTR)=','
9862          CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
9863          NCSTR=NCSTR+1
9864          ICSTR(NCSTR:NCSTR)=')'
9865        ENDIF
986615010 CONTINUE
9867      IF(IPTS.GE.2)CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9868C
9869      GOTO9000
9870C
9871C               ******************************************************
9872C               **  STEP 160--                                      **
9873C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
9874C               ******************************************************
9875C
987616000 CONTINUE
9877      IF(NP.LE.0 .OR. JPATT.LE.0)GOTO9000
9878      CALL DPCONA(34,IQUOTE)
9879C
9880      ISVGLN=ISVGLN+1
9881      ICSTR(1:9)='   <g id='
9882      ICSTR(10:10)=IQUOTE
9883      NCSTR=10
9884      IF(ISVGLN.LE.9)THEN
9885        NCHTOT=1
9886      ELSEIF(ISVGLN.LE.99)THEN
9887        NCHTOT=2
9888      ELSEIF(ISVGLN.LE.999)THEN
9889        NCHTOT=3
9890      ELSEIF(ISVGLN.LE.9999)THEN
9891        NCHTOT=4
9892      ELSEIF(ISVGLN.LE.99999)THEN
9893        NCHTOT=5
9894      ELSE
9895        NCHTOT=6
9896      ENDIF
9897      CALL GRTRIN(ISVGLN,NCHTOT,ICSTR,NCSTR)
9898      NCSTR=NCSTR+1
9899      ICSTR(NCSTR:NCSTR)=IQUOTE
9900      NCSTR=NCSTR+1
9901      ICSTR(NCSTR:NCSTR)='>'
9902      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9903C
9904      ICSTR(1:12)='   <polyline'
9905      NCSTR=-12
9906      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9907C
9908      IF(ISVGSS(1:3).EQ.'EXT')THEN
9909C
9910        NCSTR=12
9911        ICSTR(1:NCSTR)='      class='
9912        NCSTR=NCSTR+1
9913        ICSTR(NCSTR:NCSTR)=IQUOTE
9914        NCSTR=NCSTR+1
9915C
9916        JTEMP=INT(PTHIC2+0.5)
9917        IF(JTEMP.LE.1)THEN
9918          ICSTR(NCSTR:NCSTR+6)='narrow-'
9919          NCSTR=NCSTR+7
9920        ELSEIF(JTEMP.GE.2 .AND. JTEMP.LE.3)THEN
9921          ICSTR(NCSTR:NCSTR+6)='medium-'
9922          NCSTR=NCSTR+7
9923        ELSEIF(JTEMP.GE.4 .AND. JTEMP.LE.5)THEN
9924          ICSTR(NCSTR:NCSTR+4)='wide-'
9925          NCSTR=NCSTR+5
9926        ELSE
9927          ICSTR(NCSTR:NCSTR+9)='extrawide-'
9928          NCSTR=NCSTR+10
9929        ENDIF
9930        IF(JPATT.EQ.1)THEN
9931          ICSTR(NCSTR:NCSTR+4)='solid'
9932          NCSTR=NCSTR+5
9933        ELSEIF(JPATT.EQ.2)THEN
9934          ICSTR(NCSTR:NCSTR+3)='dash'
9935          NCSTR=NCSTR+4
9936        ELSEIF(JPATT.EQ.3)THEN
9937          ICSTR(NCSTR:NCSTR+5)='dotted'
9938          NCSTR=NCSTR+6
9939        ELSEIF(JPATT.EQ.4)THEN
9940          ICSTR(NCSTR:NCSTR+4)='dash2'
9941          NCSTR=NCSTR+5
9942        ELSEIF(JPATT.EQ.5)THEN
9943          ICSTR(NCSTR:NCSTR+4)='dash3'
9944          NCSTR=NCSTR+5
9945        ELSEIF(JPATT.EQ.6)THEN
9946          ICSTR(NCSTR:NCSTR+4)='dash4'
9947          NCSTR=NCSTR+5
9948        ELSEIF(JPATT.EQ.7)THEN
9949          ICSTR(NCSTR:NCSTR+4)='dash5'
9950          NCSTR=NCSTR+5
9951        ELSE
9952          ICSTR(NCSTR:NCSTR+4)='solid'
9953          NCSTR=NCSTR+5
9954        ENDIF
9955C
9956        ICSTR(NCSTR:NCSTR)=IQUOTE
9957        NCSTR=-NCSTR
9958        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
9959C
9960        CALL GRTRCO('FORE',ISVGFC,JCOL2)
9961        NCSTR=21
9962        ICSTR(1:NCSTR)='      style="stroke:#'
9963        NCHTOT=2
9964        JTEMP=JCOL
9965        IF(JTEMP.LE.0)THEN
9966C
9967C         DATAPLOT CURRENTLY ALLOWS GREYSCALE VALUES IN
9968C         THE RANGE 0 TO 100.  FOR SPECIFYING COLOR TO SVG,
9969C         SCALE THAT 0 TO 100 VALUE TO A 0 TO 255 VALUE.
9970C
9971          AVAL=(255./100.)*REAL(ABS(JTEMP))
9972          IF(AVAL.LE.0.0)AVAL=0.0
9973          IF(AVAL.GE.255.0)AVAL=255.0
9974          JRED=INT(AVAL+0.5)
9975          JBLUE=JRED
9976          JGREEN=JRED
9977        ELSE
9978          IF(JTEMP.LT.1 .OR. JTEMP.GT.MAXCLR)JTEMP=1
9979          JRED=IRED(JTEMP)
9980          JGREEN=IGREEN(JTEMP)
9981          JBLUE=IBLUE(JTEMP)
9982        ENDIF
9983        CALL DPCONX(JRED,ICJUNK)
9984        NCSTR=NCSTR+1
9985        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
9986        NCSTR=NCSTR+1
9987        CALL DPCONX(JGREEN,ICJUNK)
9988        NCSTR=NCSTR+1
9989        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
9990        NCSTR=NCSTR+1
9991        CALL DPCONX(JBLUE,ICJUNK)
9992        NCSTR=NCSTR+1
9993        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
9994        NCSTR=NCSTR+2
9995        ICSTR(NCSTR:NCSTR)=';'
9996        NCSTR=NCSTR+1
9997        ICSTR(NCSTR:NCSTR)=IQUOTE
9998        NCSTR=-NCSTR
9999        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10000C
10001      ELSE
10002C
10003        ICSTR(1:12)='      style='
10004        ICSTR(13:13)=IQUOTE
10005        NCSTR=-13
10006        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10007        ICSTR(1:26)='             stroke-width:'
10008        NCSTR=26
10009        JTEMP=INT(PTHIC2+0.5)
10010        IF(JTEMP.LT.1)JTEMP=1
10011        IF(JTEMP.GT.50)JTEMP=50
10012        NCHTOT=1
10013        IF(JTEMP.GE.10)NCHTOT=2
10014        CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10015        NCSTR=NCSTR+1
10016        ICSTR(NCSTR:NCSTR)=';'
10017        NCSTR=-NCSTR
10018        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10019C
10020        IF(ISVGCA.EQ.'ROUN')THEN
10021          NCSTR=35
10022          ICSTR(1:NCSTR)='             stroke-linecap: round;'
10023          NCSTR=-NCSTR
10024          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10025        ELSEIF(ISVGCA.EQ.'SQUA')THEN
10026          NCSTR=36
10027          ICSTR(1:NCSTR)='             stroke-linecap: square;'
10028          NCSTR=-NCSTR
10029          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10030        ELSEIF(ISVGCA.EQ.'BUTT')THEN
10031          NCSTR=34
10032          ICSTR(1:NCSTR)='             stroke-linecap: butt;'
10033          NCSTR=-NCSTR
10034          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10035        ELSE
10036          CONTINUE
10037        ENDIF
10038C
10039        IF(ISVGJS.EQ.'ROUN')THEN
10040          NCSTR=36
10041          ICSTR(1:NCSTR)='             stroke-linejoin: round;'
10042          NCSTR=-NCSTR
10043          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10044        ELSEIF(ISVGJS.EQ.'BEVE')THEN
10045          NCSTR=36
10046          ICSTR(1:NCSTR)='             stroke-linejoin: bevel;'
10047          NCSTR=-NCSTR
10048          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10049        ELSEIF(ISVGJS.EQ.'MITE')THEN
10050          NCSTR=36
10051          ICSTR(1:NCSTR)='             stroke-linejoin: miter;'
10052          NCSTR=-NCSTR
10053          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10054        ELSE
10055          CONTINUE
10056        ENDIF
10057C
10058        ICSTR(1:21)='             stroke:#'
10059        NCSTR=21
10060        NCHTOT=2
10061        JTEMP=JCOL
10062        IF(JTEMP.LE.0)THEN
10063C
10064C         DATAPLOT CURRENTLY ALLOWS GREYSCALE VALUES IN
10065C         THE RANGE 0 TO 100.  FOR SPECIFYING COLOR TO SVG,
10066C         SCALE THAT 0 TO 100 VALUE TO A 0 TO 255 VALUE.
10067C
10068          AVAL=(255./100.)*REAL(ABS(JTEMP))
10069          IF(AVAL.LE.0.0)AVAL=0.0
10070          IF(AVAL.GE.255.0)AVAL=255.0
10071          JRED=INT(AVAL+0.5)
10072          JBLUE=JRED
10073          JGREEN=JRED
10074        ELSE
10075          IF(JTEMP.LT.1 .OR. JTEMP.GT.MAXCLR)JTEMP=1
10076          JRED=IRED(JTEMP)
10077          JGREEN=IGREEN(JTEMP)
10078          JBLUE=IBLUE(JTEMP)
10079        ENDIF
10080        CALL DPCONX(JRED,ICJUNK)
10081        NCSTR=NCSTR+1
10082        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
10083        NCSTR=NCSTR+1
10084        CALL DPCONX(JGREEN,ICJUNK)
10085        NCSTR=NCSTR+1
10086        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
10087        NCSTR=NCSTR+1
10088        CALL DPCONX(JBLUE,ICJUNK)
10089        NCSTR=NCSTR+1
10090        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
10091        NCSTR=NCSTR+2
10092        ICSTR(NCSTR:NCSTR)=';'
10093        NCSTR=-NCSTR
10094        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10095C
10096        IF(JPATT.GE.2 .AND. JPATT.LE.8)THEN
10097          NCHTOT=3
10098          NCSTR=31
10099          ICSTR(1:NCSTR)='             stroke-dasharray: '
10100          IF(JPATT.EQ.2)THEN
10101            JTEMP=3
10102            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10103            NCSTR=NCSTR+1
10104            ICSTR(NCSTR:NCSTR)=','
10105            JTEMP=3
10106            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10107          ELSEIF(JPATT.EQ.3)THEN
10108            JTEMP=1
10109            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10110            NCSTR=NCSTR+1
10111            ICSTR(NCSTR:NCSTR)=','
10112            JTEMP=1
10113            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10114          ELSEIF(JPATT.EQ.4)THEN
10115            JTEMP=9
10116            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10117            NCSTR=NCSTR+1
10118            ICSTR(NCSTR:NCSTR)=','
10119            JTEMP=5
10120            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10121          ELSEIF(JPATT.EQ.5)THEN
10122            JTEMP=5
10123            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10124            NCSTR=NCSTR+1
10125            ICSTR(NCSTR:NCSTR)=','
10126            JTEMP=3
10127            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10128            NCSTR=NCSTR+1
10129            ICSTR(NCSTR:NCSTR)=','
10130            JTEMP=9
10131            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10132            NCSTR=NCSTR+1
10133            ICSTR(NCSTR:NCSTR)=','
10134            JTEMP=2
10135            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10136          ELSEIF(JPATT.EQ.6)THEN
10137            JTEMP=9
10138            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10139            NCSTR=NCSTR+1
10140            ICSTR(NCSTR:NCSTR)=','
10141            JTEMP=3
10142            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10143            NCSTR=NCSTR+1
10144            ICSTR(NCSTR:NCSTR)=','
10145            JTEMP=5
10146            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10147            NCSTR=NCSTR+1
10148            ICSTR(NCSTR:NCSTR)=','
10149            JTEMP=9
10150            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10151            NCSTR=NCSTR+1
10152            ICSTR(NCSTR:NCSTR)=','
10153            JTEMP=3
10154            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10155            NCSTR=NCSTR+1
10156            ICSTR(NCSTR:NCSTR)=','
10157            JTEMP=5
10158            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10159          ELSEIF(JPATT.EQ.7)THEN
10160            JTEMP=3
10161            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10162            NCSTR=NCSTR+1
10163            ICSTR(NCSTR:NCSTR)=','
10164            JTEMP=1
10165            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10166            NCSTR=NCSTR+1
10167            ICSTR(NCSTR:NCSTR)=','
10168            JTEMP=3
10169            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10170            NCSTR=NCSTR+1
10171            ICSTR(NCSTR:NCSTR)=','
10172            JTEMP=1
10173            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10174          ELSEIF(JPATT.EQ.8)THEN
10175            JTEMP=5
10176            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10177            NCSTR=NCSTR+1
10178            ICSTR(NCSTR:NCSTR)=','
10179            JTEMP=2
10180            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10181            NCSTR=NCSTR+1
10182            ICSTR(NCSTR:NCSTR)=','
10183            JTEMP=5
10184            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10185            NCSTR=NCSTR+1
10186            ICSTR(NCSTR:NCSTR)=','
10187            JTEMP=2
10188            CALL GRTRIN(JTEMP,NCHTOT,ICSTR,NCSTR)
10189          ENDIF
10190          NCSTR=NCSTR+1
10191          ICSTR(NCSTR:NCSTR)=';'
10192          NCSTR=-NCSTR
10193          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10194        ENDIF
10195C
10196        NCSTR=23
10197        ICSTR(1:NCSTR)='             fill:none;'
10198        NCSTR=-NCSTR
10199        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10200C
10201        ICSTR(1:13)='             '
10202        ICSTR(14:14)=IQUOTE
10203        NCSTR=-14
10204        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10205C
10206      END IF
10207C
10208      ICSTR(1:13)='      points='
10209      ICSTR(14:14)=IQUOTE
10210      NCSTR=-14
10211      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10212C
10213      NCSTR=3
10214      ICSTR(1:NCSTR)='   '
10215      I=1
10216      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
10217      NCHTOT=5
10218      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
10219      NCSTR=NCSTR+1
10220      ICSTR(NCSTR:NCSTR)=','
10221      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
10222      NCSTR=NCSTR+1
10223      IF(NP.LE.1)THEN
10224        ICSTR(NCSTR:NCSTR)=','
10225        GOTO16050
10226      ELSE
10227        ICSTR(NCSTR:NCSTR)=','
10228      ENDIF
10229C
10230      DO16020I=2,NP
10231        IF(NCSTR.GT.110)THEN
10232          NCSTR=-NCSTR
10233          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10234          NCSTR=3
10235          ICSTR(1:NCSTR)='   '
10236        ENDIF
10237        CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
10238        CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
10239        NCSTR=NCSTR+1
10240        ICSTR(NCSTR:NCSTR)=','
10241        CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
10242        NCSTR=NCSTR+1
10243        IF(I.EQ.NP)THEN
10244          ICSTR(NCSTR:NCSTR)=' '
10245        ELSE
10246          ICSTR(NCSTR:NCSTR)=','
10247        ENDIF
10248        IF(NCSTR.LE.110)GOTO16020
10249        NCSTR=-NCSTR
10250        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10251        NCSTR=3
10252        ICSTR(1:NCSTR)='   '
1025316020 CONTINUE
10254C
1025516050 CONTINUE
10256      IF(NCSTR.GT.3)THEN
10257        NCSTR=-NCSTR
10258        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10259      ENDIF
10260C
10261      ICSTR(1:3)='   '
10262      ICSTR(4:4)=IQUOTE
10263      ICSTR(5:6)='/>'
10264      NCSTR=-6
10265      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10266C
10267      ICSTR(1:7)='   </g>'
10268      NCSTR=-7
10269      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10270C
10271      GOTO9000
10272C
10273C               ******************************************************
10274C               **  STEP 170--                                      **
10275C               **  TREAT THE CAIRO                          DRIVER **
10276C               ******************************************************
10277C
1027817000 CONTINUE
10279#ifdef HAVE_CAIRO
10280      IF(NP.LE.1 .OR. JPATT.EQ.-1)GOTO9000
10281C
10282C     SET CAP AND JOIN STYLES
10283C
10284      IF(ICAICA.EQ.'BUTT')THEN
10285        ICAP=2
10286      ELSEIF(ICAICA.EQ.'ROUN')THEN
10287        ICAP=3
10288      ELSEIF(ICAICA.EQ.'SQUA')THEN
10289        ICAP=4
10290      ELSE
10291        ICAP=1
10292      ENDIF
10293      IF(ICAIJS.EQ.'MITE')THEN
10294        IJOIN=2
10295      ELSEIF(ICAIJS.EQ.'ROUN')THEN
10296        IJOIN=3
10297      ELSEIF(ICAICA.EQ.'BEVE')THEN
10298        IJOIN=4
10299      ELSE
10300        IJOIN=1
10301      ENDIF
10302C
10303      IVAL2=1
10304      IF(IGUNIT.EQ.IPL1NU)IVAL2=2
10305      IF(IGUNIT.EQ.IPL2NU)IVAL2=3
10306      DO17010I=1,NP
10307        PXP(I)=PX(I)
10308        PYP(I)=PY(I)
10309        CALL GRTRSD(PXP(I),PYP(I),IX1,IY1,ISUBN0)
1031017010 CONTINUE
10311C
10312      IF(NP.LE.1000)THEN
10313        CALL CADRAW(IVAL2,PXP,PYP,NP,ICAP,IJOIN,JPATT,PTHIC2)
10314      ELSE
10315        NMAXPT=999
10316        NLOOP=NP/NMAXPT
10317        IF(MOD(NP,NMAXPT).GT.0)NLOOP=NLOOP+1
10318        DO17520I=1,NLOOP
10319          ISTRT=(I-1)*NMAXPT + 1
10320          IF(I.GT.1)ISTRT=ISTRT-1
10321          ISTOP=I*NMAXPT
10322          IF(ISTOP.GT.NP)ISTOP=NP
10323          NPTEMP=ISTOP-ISTRT+1
10324          CALL CADRAW(IVAL2,PXP(ISTRT),PYP(ISTRT),NPTEMP,
10325     1            ICAP,IJOIN,JPATT,PTHIC2)
1032617520   CONTINUE
10327      ENDIF
10328#endif
10329      GOTO9000
10330C
10331C               ******************************************************
10332C               **  STEP 180--                                      **
10333C               **  TREAT THE WMF                            DRIVER **
10334C               ******************************************************
10335C
1033618000 CONTINUE
10337      GOTO9000
10338C
10339C               ******************************************************
10340C               **  STEP 190--                                      **
10341C               **  TREAT THE D3                             DRIVER **
10342C               ******************************************************
10343C
1034419000 CONTINUE
10345      GOTO9000
10346C
10347C               *****************
10348C               **  STEP 90--  **
10349C               **  EXIT       **
10350C               *****************
10351C
10352 9000 CONTINUE
10353      IF(IBUGG4.EQ.'ON' .OR. ISUBG4.EQ.'DRPL')THEN
10354        WRITE(ICOUT,999)
10355        CALL DPWRST('XXX','BUG ')
10356        WRITE(ICOUT,9011)
10357 9011   FORMAT('***** AT THE END       OF GRDRPL--')
10358        CALL DPWRST('XXX','BUG ')
10359        WRITE(ICOUT,9033)IERRG4,NCSTR
10360 9033   FORMAT('IERRG4,NCSTR = ',A4,2X,I8)
10361        CALL DPWRST('XXX','BUG ')
10362        IF(NCSTR.GT.0)THEN
10363          DO9035I=1,NCSTR
10364            CALL DPCOAN(ICSTR(I:I),IASCNE)
10365            WRITE(ICOUT,9036)I,ICSTR(I:I),IASCNE
10366 9036       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
10367            CALL DPWRST('XXX','BUG ')
10368 9035     CONTINUE
10369        ENDIF
10370      ENDIF
10371C
10372      RETURN
10373      END
10374      SUBROUTINE GRERSC(JCOL,ICOLT)
10375C
10376C     PURPOSE--ERASE THE SCREEN OF A SPECIFIC GRAPHICS DEVICE, AND (IF A
10377C              COLOR DEVICE) FLOOD THE SCREEN WITH THE PRE-SCRIBED
10378C              BACKGROUND COLOR.
10379C     WRITTEN BY--JAMES J. FILLIBEN
10380C                 STATISTICAL ENGINEERING DIVISION
10381C                 INFORMATION TECHNOLOGY LABORATORY
10382C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
10383C                 GAITHERSBURG, MD 20899-8980
10384C                 PHONE--301-975-2855
10385C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
10386C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
10387C     LANGUAGE--ANSI FORTRAN (1977)
10388C     VERSION NUMBER--83.6
10389C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
10390C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
10391C                                      DRIVER OBSOLETE
10392C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
10393C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
10394C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
10395C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
10396C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
10397C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
10398C     UPDATED         --MAY      1990. ADD AF COMMAND TO HP-GL (BY ALAN)
10399C     UPDATED         --JULY     1990. BACKGROUND COLOR FOR SOME HP 2622 (ALAN)
10400C     UPDATED         --NOVEMBER 1990. POSTSCRIPT BUG FIX (BY ALAN)
10401C     UPDATED         --JANUARY  1991. ADD COLOR SUPPORT TO REGIS (ALAN)
10402C     UPDATED         --MAY      1991. 3 ISUBNO TO ISUBN0 (JJF)
10403C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
10404C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
10405C                                      DRIVER OBSOLETE
10406C     UPDATED         --MAY      1991. FIX 4027
10407C     UPDATED         --OCTOBER  1991. POSTSCRIPT FONTS TABLE DRIVEN (ALAN)
10408C     UPDATED         --MAY      1992. AVOID POSTSCRIPT BLANK PAGE
10409C     UPDATED         --MAY      1992. DEBUG STATEMENTS
10410C     UPDATED         --AUGUST   1992. SET BACKGROUND FOR CGM (ALAN)
10411C                                      HP-GL FOR LASERJET III
10412C     UPDATED         --JANUARY  1993. POSTSCRIPT PAGE NUMBER (ALAN)
10413C     UPDATED         --JANUARY  1993. POSTSCRIPT "%%" LINES (ALAN)
10414C     UPDATED         --OCTOBER  1993. POSTSCRIPT SET BACKGROUND (ALAN)
10415C     UPDATED         --MAY      1996. MINOR FIX TO X11
10416C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
10417C                                      (OLD CALCOMP STYLE)
10418C                                      DRIVER OBSOLETE
10419C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
10420C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
10421C                                      USE BILL MITCHELLS OPENGL
10422C                                      BINDING FOR FORTRAN
10423C     UPDATED         --OCTOBER  1996. GKS (ALAN)
10424C                                      CODED, NOT TESTED
10425C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
10426C                                      PLACEHOLDER FOR NOW
10427C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
10428C                                      PLACEHOLDER FOR NOW
10429C     UPDATED         --FEBRUARY 1997. BUG FIX FOR QWIN
10430C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
10431C                                      PLACEHOLDER FOR NOW
10432C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
10433C     UPDATED         --JUNE     2000. MACINTOSH
10434C                                      PLACEHOLDER FOR NOW
10435C                     --MARCH    2002. CHANGE TO QUARTZ (NEW MAC GRAPHICS
10436C                                      LIBRARY)
10437C     UPDATED         --JUNE     2000. PC PRINTER
10438C                                      PLACEHOLDER FOR NOW
10439C                     --MARCH    2002. CHANGE TO GHOSTSCRIPT
10440C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
10441C                                      PLACEHOLDER FOR NOW
10442C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
10443C     UPDATED         --JANUARY  2003. SOME POSTSCRIPT FIXES
10444C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
10445C     UPDATED         --FEBRUARY 2006. IMPLEMENT LATEX DRIVER
10446C     UPDATED         --APRIL    2009. IMPLEMENT LIBPLOT DRIVER
10447C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
10448C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
10449C     UPDATED         --DECEMBER 2009. FIX FOR DEVICE 3 POSTSCRIPT OUTPUT
10450C     UPDATED         --NOVEMNER 2015. IDEVO3 OPTION FOR DEVICE 3 OUTPUT
10451C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
10452C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
10453C                                      DEVICE DRIVERS (CAIRO, WMF, D3)
10454C
10455#ifdef HAVE_WININTERACTER
10456      USE WINTERACTER
10457#endif
10458#ifdef HAVE_INTERACTER
10459      USE INTERACTER
10460#endif
10461#ifdef HAVE_QWIN
10462CQWIN USE DFLIB
10463      USE IFQWIN
10464CCCCC LOGICAL MODESTATUS
10465      TYPE (WINDOWCONFIG)   DPSCREEN
10466      CHARACTER*4 QWSCRN
10467      COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
10468#endif
10469C
10470C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
10471C
10472      CHARACTER*130 ICSTR
10473      CHARACTER*4 ISUBN0
10474      CHARACTER*4 ICOLT
10475      CHARACTER*1 IQUOTE
10476      CHARACTER*1 ICARAT
10477      CHARACTER*2 ICJUNK
10478C  AUGUST 1992.  ADD FOLLOWING LINE
10479      PARAMETER(MAXCLR=89)
10480      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
10481C  OCTOBER 1993.  ADD FOLLOWING LINE
10482      DIMENSION PX(5)
10483      DIMENSION PY(5)
10484C  JULY 1996.  ADD FOLLOWING SECTION.
10485#ifdef HAVE_LAHEY_CALCOMP
10486      INTEGER ILAHEY(9)
10487      REAL RLAHEY(8)
10488      CHARACTER*40 CLAHEY
10489#endif
10490C  FEBRUARY 2001.  ADD FOLLOWING SECTION FOR JPEG, PNG DRIVER.
10491      INTEGER IADE(81)
10492C
10493C-----COMMON----------------------------------------------------------
10494C
10495      INCLUDE 'DPCOPA.INC'
10496      INCLUDE 'DPCOGR.INC'
10497      INCLUDE 'DPCONP.INC'
10498      INCLUDE 'DPCOBE.INC'
10499      INCLUDE 'DPCODV.INC'
10500      INCLUDE 'DPCOST.INC'
10501CCCCC THE FOLLOWING LINE WAS ADDED    MAY 1992 (JJF)
10502      INCLUDE 'DPCOF2.INC'
10503C
10504      CHARACTER*4 IPSTNW
10505      CHARACTER*4 IPSTN2
10506      COMMON/IPSTNW/IPSTNW,IPSTN2
10507C
10508      INTEGER IGKSID
10509      INTEGER IGKSWK
10510      INTEGER IGKSTY
10511      COMMON/IGKS/IGKSID,IGKSWK,IGKSTY
10512C
10513C-----COMMON VARIABLES (GENERAL)--------------------------------------
10514C
10515C  AUGUST 1992.  DEFINE RGB COLORS FOR CGM
10516C
10517      INCLUDE 'DPCOCT.INC'
10518      INCLUDE 'DPCOP2.INC'
10519C
10520C-----START POINT-----------------------------------------------------
10521C
10522      ISUBN0='ERSC'
10523      IERRG4='NO'
10524C
10525      NCSTR=(-999)
10526      ICHAPS=0
10527      INULLI=0
10528C
10529      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'ERSC')THEN
10530        WRITE(ICOUT,999)
10531  999   FORMAT(1X)
10532        CALL DPWRST('XXX','BUG ')
10533        WRITE(ICOUT,51)
10534   51   FORMAT('***** AT THE BEGINNING OF GRERSC--')
10535        CALL DPWRST('XXX','BUG ')
10536        WRITE(ICOUT,53)JCOL,IGBAUD,AGERDE
10537   53   FORMAT('JCOL,IGBAUD,AGERDE = ',2I8,G15.7)
10538        CALL DPWRST('XXX','BUG ')
10539CCCCC   THE FOLLOWING 2 LINES WERE ADDED   MAY 1992
10540        WRITE(ICOUT,54)IPL1CS,IPL2CS,IPSTBP,IPSTPN
10541   54   FORMAT('IPL1CS,IPL2CS,IPSTBP, IPSTPN = '3(A4,2X),2X,I6)
10542        CALL DPWRST('XXX','BUG ')
10543        WRITE(ICOUT,55)IMANUF,IMODEL,IBUGG4,IGUNIT
10544   55   FORMAT('IMANUF,IMODEL,IBUGG4,IGUNIT = ',3(A4,2X),A4)
10545        CALL DPWRST('XXX','BUG ')
10546      ENDIF
10547C
10548C               ********************************************
10549C               **  STEP 1--                              **
10550C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
10551C               **  AND THE MODEL                         **
10552C               ********************************************
10553C
10554      IF(IMANUF.EQ.'QWIN')THEN
10555        GOTO4700
10556      ELSEIF(IMANUF.EQ.'POST')THEN
10557        GOTO8600
10558      ELSEIF(IMANUF.EQ.'X11 ')THEN
10559        GOTO9600
10560      ELSEIF(IMANUF.EQ.'AQUA')THEN
10561        GOTO13500
10562      ELSEIF(IMANUF.EQ.'GENE')THEN
10563        IF(IMODEL.EQ.'CODE')GOTO3200
10564        IF(IMODEL.EQ.'CGM')GOTO3300
10565        IF(IMODEL.EQ.'CGMB')GOTO3400
10566        GOTO3100
10567      ELSEIF(IMANUF.EQ.'SVG ')THEN
10568        GOTO16000
10569      ELSEIF(IMANUF.EQ.'GD  ')THEN
10570        GOTO12000
10571      ELSEIF(IMANUF.EQ.'LATE')THEN
10572        GOTO15000
10573      ELSEIF(IMANUF.EQ.'CAIR')THEN
10574        GOTO17000
10575      ELSEIF(IMANUF.EQ.'D3  ')THEN
10576        GOTO19000
10577      ELSEIF(IMANUF.EQ.'WMF ')THEN
10578        GOTO18000
10579      ELSEIF(IMANUF.EQ.'OPGL')THEN
10580        GOTO4800
10581      ELSEIF(IMANUF.EQ.'TEKT')THEN
10582        IF(IMODEL.EQ.'4662')GOTO9000
10583C
10584        IF(IMODEL.EQ.'4020')GOTO1200
10585        IF(IMODEL.EQ.'4022')GOTO1200
10586        IF(IMODEL.EQ.'4025')GOTO1200
10587        IF(IMODEL.EQ.'4027')GOTO1200
10588C
10589        IF(IMODEL.EQ.'4105')GOTO1300
10590        IF(IMODEL.EQ.'4107')GOTO1300
10591        IF(IMODEL.EQ.'4109')GOTO1300
10592        IF(IMODEL.EQ.'4115')GOTO1300
10593        IF(IMODEL.EQ.'4107')GOTO1300
10594        IF(IMODEL.EQ.'4109')GOTO1300
10595        IF(IMODEL.EQ.'4115')GOTO1300
10596C
10597        GOTO1100
10598      ELSEIF(IMANUF.EQ.'HP')THEN
10599        IF(IMODEL.EQ.'7221')GOTO2100
10600        IF(IMODEL.EQ.'2622')GOTO2300
10601        IF(IMODEL.EQ.'2623')GOTO2300
10602        IF(IMODEL.EQ.'2627')GOTO2300
10603        IF(IMODEL.EQ.'2647')GOTO2300
10604        GOTO2200
10605      ELSEIF(IMANUF.EQ.'LIBP')THEN
10606        GOTO2600
10607      ELSEIF(IMANUF.EQ.'REGI')THEN
10608        GOTO8100
10609      ELSEIF(IMANUF.EQ.'GKS ')THEN
10610        GOTO11000
10611      ELSEIF(IMANUF.EQ.'LAHE')THEN
10612        IF(IMODEL.EQ.'INTE')GOTO4900
10613        IF(IMODEL.EQ.'WINT')GOTO4950
10614        GOTO4600
10615      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
10616        GOTO13000
10617      ELSEIF(IMANUF.EQ.'QUIC')THEN
10618        GOTO9100
10619      ELSEIF(IMANUF.EQ.'CALC')THEN
10620        GOTO4100
10621      ELSEIF(IMANUF.EQ.'ZETA')THEN
10622        GOTO5100
10623      ELSEIF(IMANUF.EQ.'TURB')THEN
10624        GOTO10000
10625      ELSEIF(IMANUF.EQ.'SUN ')THEN
10626        GOTO6600
10627      ENDIF
10628      GOTO9000
10629C
10630C               ************************************************************
10631C               **  STEP 11--                                             **
10632C               **  TREAT THE TEKTRONIX 400X, 401X, 405X, AND 4114 CASES  **
10633C               **  (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES)      **
10634C               **  TO ERASE THE SCREEN,                                  **
10635C               **  WRITE OUT AN ESCAPE FORM-FEED                         **
10636C               ************************************************************
10637C
10638 1100 CONTINUE
10639      ICSTR(1:1)=IESCC
10640      ICSTR(2:2)=IFFC
10641      NCSTR=2
10642      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10643C
10644      DO1130J=1,10
10645        ICSTR(J:J)=INULC
10646 1130 CONTINUE
10647      NCSTR=10
10648C
10649      INULLI=INT(AGERDE+0.5)
10650      IF(INULLI.GT.0)THEN
10651        DO1135I=1,INULLI
10652          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10653 1135   CONTINUE
10654      ENDIF
10655C
10656      GOTO9000
10657C
10658C               ******************************************************
10659C               **  STEP 12--                                       **
10660C               **  TREAT THE TEKTRONIX 4020, 4022, AND 4025 CASES  **
10661C               **  (NON-COLOR RASTER DEVICES).                     **
10662C               **  TO ERASE THE SCREEN,                            **
10663C               **  USE THE !ERA COMMAND                            **
10664C               **  REFERENCE--4027 OPERATOR'S MANUAL, PAGE 5-6.    **
10665C               ******************************************************
10666C
10667 1200 CONTINUE
10668      ICSTR(1:9)='!ERA G C;'
10669      IX=JCOL+48
10670      CALL DPCONA(IX,ICSTR(10:10))
10671      ICSTR(11:11)=';'
10672      NCSTR=11
10673      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10674      GOTO9000
10675C
10676C               ******************************************************
10677C               **  STEP 13--                                       **
10678C               **  TREAT THE 4105 CASE                             **
10679C               **  (COLOR DEVICE)                                  **
10680C               **  TO ERASE THE SCREEN,                            **
10681C               **  SET THE BACKGROUND COLOR AND                    **
10682C               **  THEN CARRY OUT THE ERASE                        **
10683C               **  REFERENCE--PAGE 5-51                            **
10684C               ******************************************************
10685C
10686 1300 CONTINUE
10687      ICSTR(1:1)=IESCC
10688      ICSTR(2:4)='RA1'
10689      IX=JCOL+48
10690      CALL DPCONA(IX,ICSTR(5:5))
10691      ICSTR(6:6)='0'
10692      NCSTR=6
10693      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10694      ICSTR(1:1)=IESCC
10695      ICSTR(2:2)=IFFC
10696      NCSTR=2
10697      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10698      GOTO9000
10699C
10700C               ******************************************************
10701C               **  STEP 21--                                       **
10702C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
10703C               **  (MULTI-COLOR PENPLOTTER)                        **
10704C               **  THERE IS NO    ERASE      INSTRUCTION PER SE.   **
10705C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
10706C               **             OPERATING AND PROGRAMMING MANUAL,    **
10707C               **             PAGE XX.                             **
10708C               ******************************************************
10709C
10710 2100 CONTINUE
10711      GOTO9000
10712C
10713C               ******************************************************
10714C               **  STEP 22--                                       **
10715C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
10716C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
10717C               **  (MULTI-COLOR PENPLOTTERS)                       **
10718C               **  THERE IS NO    ERASE      INSTRUCTION PER SE.   **
10719C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
10720C               **             OPERATING AND PROGRAMMING MANUAL,    **
10721C               **             PAGE XX, XXX.                        **
10722C               ******************************************************
10723C
10724C  MAY, 1990.  ADD AN "ADVANCE PAGE" COMMAND.  HOWEVER, DO NOT SEND ON FIRST
10725C  PLOT.
10726C
10727C  AUGUST, 1992.  HANDLE LASER JET III CASE SEPARATELY.  TO ADVANCE
10728C  PAGE, NEED TO EXIT BACK INTO LASER JET MODE.
10729 2200 CONTINUE
10730      IF(IMODE3.EQ.'LJET')THEN
10731        ICSTR(1:1)=IESCC
10732        ICSTR(2:2)='E'
10733        NCSTR=2
10734        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10735        ICSTR(2:4)='%0B'
10736        NCSTR=4
10737        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10738        ICSTR(1:3)='IN;'
10739        NCSTR=3
10740        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10741        ICSTR(1:4)='RO90'
10742        NCSTR=4
10743        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10744      ELSEIF(IHPGSW.EQ.'ON')THEN
10745        ICSTR(1:3)='AF;'
10746        NCSTR=3
10747        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10748      ELSE
10749        IHPGSW='ON'
10750      ENDIF
10751C
10752C               **********************************************************
10753C               **  STEP 23--                                           **
10754C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
10755C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
10756C               **  (MONOCHROME DISPLAY TERMINALS)                      **
10757C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
10758C               **             REFERENCE MANUAL,                        **
10759C               **             PAGE 10-4, 10-3.                         **
10760C               **********************************************************
10761C
10762C  JULY, 1990.  SET BACKGROUND COLOR FOR 2622 TYPE DEVICES THAT SUPPORT COLOR
10763C
10764 2300 CONTINUE
10765      NCSTR=1
10766      ICSTR(NCSTR:NCSTR)=IESCC
10767      NCSTR=NCSTR+1
10768      NCSTR2=NCSTR+3
10769      ICSTR(NCSTR:NCSTR2)='*daZ'
10770      NCSTR=NCSTR2
10771      IF(IGCOLO.EQ.'ON')THEN
10772        NCSTR=NCSTR+1
10773        ICSTR(NCSTR:NCSTR)=IESCC
10774        NCSTR=NCSTR+1
10775        NCSTR2=NCSTR+1
10776        ICSTR(NCSTR:NCSTR2)='*e'
10777        NCSTR=NCSTR2
10778        NCHTOT=1
10779        CALL GRTRIN(JCOL,NCHTOT,ICSTR,NCSTR)
10780        NCSTR=NCSTR+1
10781        ICSTR(NCSTR:NCSTR)='B'
10782      ENDIF
10783      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10784      GOTO9000
10785C
10786C               **********************************************************
10787C               **  STEP 26--                                           **
10788C               **  TREAT THE UNIX LIBPLOT              CASE            **
10789C               **********************************************************
10790C
10791 2600 CONTINUE
10792C
10793      IFACT=65535/255
10794      IVALR=IFACT*IRED(JCOL)
10795      IVALG=IFACT*IGREEN(JCOL)
10796      IVALB=IFACT*IBLUE(JCOL)
10797C
10798      IXTEMP = INT(ANUMHP+0.5)
10799      IYTEMP = INT(ANUMVP+0.5)
10800      IADE(1)=53
10801      IADE(2)=55
10802      IADE(3)=48
10803      IADE(4)=ICHAR('x')
10804      IADE(5)=53
10805      IADE(6)=55
10806      IADE(7)=48
10807      IADE(8)=0
10808C
10809#ifdef HAVE_LIBPLOT
10810      CALL PLERAS(IADE,IVALR,IVALG,IVALB)
10811#endif
10812      GOTO9000
10813C
10814C               ******************************************************
10815C               **  STEP 31--                                       **
10816C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
10817C               ******************************************************
10818C
10819 3100 CONTINUE
10820      ICSTR(1:21)='SET COLOR BACKGROUND '
10821      ICSTR(22:25)=ICOLT(1:4)
10822      NCSTR=25
10823      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10824      ICSTR(1:12)='ERASE SCREEN'
10825      NCSTR=12
10826      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10827      GOTO9000
10828C
10829C               ***************************************************************
10830C               **  STEP 32--                                                **
10831C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
10832C               ***************************************************************
10833C
10834 3200 CONTINUE
10835      ICSTR(1:10)='SECO BACK '
10836      ICSTR(11:14)=ICOLT(1:4)
10837      NCSTR=14
10838      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10839      ICSTR(1:4)='ERSC'
10840      NCSTR=4
10841      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10842      GOTO9000
10843C
10844C               ***************************************************************
10845C               **  STEP 33--                                                **
10846C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
10847C               **  1) IF A PICTURE IS CURRENTLY ACTIVE, CLOSE IT            **
10848C               **  2) ACTIVATE A NEW PICTURE                                **
10849C               ***************************************************************
10850C
10851 3300 CONTINUE
10852C
10853      IF(ICGMSW.EQ.'ON')THEN
10854        ICSTR(1:7)='ENDPIC;'
10855        NCSTR=7
10856        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10857      ELSE
10858        CALL DPCONA(39,IQUOTE)
10859        ICSTR(1:7)='BEGPIC '
10860        ICSTR(8:8)=IQUOTE
10861        ICSTR(9:9)=' '
10862        ICSTR(10:10)=IQUOTE
10863        ICSTR(11:11)=';'
10864        NCSTR=11
10865        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10866        ICGMSW='ON'
10867C
10868C       NOTE:  BACKGROUND COLOR SHOULD SPECIFY RGB COMPONENTS (EVEN IF
10869C              COLOR MODE IS INDEXED OTHERWISE), SO LEAVE OFF.  LET POST
10870C              PROCESSOR SET THE BACKGROUND COLOR.  MAYBE AT FUTURE TIME
10871C              CAN ADD OPTION TO TRANSLATE DATAPLOT COLORS TO RGB
10872C              COMPONENTS.
10873        ICSTR(1:11)='BEGPICBODY;'
10874        NCSTR=11
10875        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10876C
10877C       AUGUST 1992.  SPECIFY BACKGROUND COLOR AS RGB VALUES.
10878C
10879        ICSTR(1:9)='BACKCOLR '
10880        NCSTR=9
10881        NCHTOT=3
10882        IVAL=IRED(JCOL)
10883        CALL GRTRIN(IVAL,NCHTOT,ICSTR,NCSTR)
10884        NCSTR=NCSTR+1
10885        ICSTR(NCSTR:NCSTR)=' '
10886        IVAL=IGREEN(JCOL)
10887        CALL GRTRIN(IVAL,NCHTOT,ICSTR,NCSTR)
10888        NCSTR=NCSTR+1
10889        ICSTR(NCSTR:NCSTR)=' '
10890        IVAL=IBLUE(JCOL)
10891        CALL GRTRIN(IVAL,NCHTOT,ICSTR,NCSTR)
10892        NCSTR=NCSTR+1
10893        ICSTR(NCSTR:NCSTR)=';'
10894        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
10895      ENDIF
10896      GOTO9000
10897C
10898C               *******************************************************
10899C               **  STEP 34--                                        **
10900C               **  TREAT THE CGM (BINARY) GENERAL CASE              **
10901C               **  1) IF A PICTURE IS CURRENTLY ACTIVE, CLOSE IT    **
10902C               **  2) ACTIVATE A NEW PICTURE                        **
10903C               *******************************************************
10904C
10905 3400 CONTINUE
10906C
10907      IF(ICGMSW.EQ.'ON')THEN
10908        CONTINUE
10909      ENDIF
10910C
10911      GOTO9000
10912C
10913C               ******************************************************
10914C               **  STEP 41--                                       **
10915C               **  TREAT THE CALCOMP XXXXXX CASE                   **
10916C               **  TO ERASE SCREEN---                              **
10917C               **  USE CALCOMP LIBRARY                             **
10918C               **  GRINDE DOES INITIAL PAGE ERASE, CHECK FOR THIS  **
10919C               **  REFERENCE--XX                                   **
10920C               **             XX                                   **
10921C               **             PAGES XX AND XX                      **
10922C               ******************************************************
10923C
10924 4100 CONTINUE
10925      IF(ICALSW.EQ.'ON')THEN
10926        ICALSW='OFF'
10927      ELSE
10928        IPEN=-3
10929        YNEW=0.
10930        DOTPPI=1000.
10931        XPAGE=ANUMHP/DOTPPI
10932        XNEW=XPAGE+1.
10933#ifdef HAVE_CALCOMP
10934        CALL PLOT(XNEW,YNEW,IPEN)
10935#endif
10936      ENDIF
10937      GOTO9000
10938C
10939C               ******************************************************
10940C               **  STEP 46--                                       **
10941C               **  TREAT THE LAHEY   XXXXXX CASE                   **
10942C               **  REFERENCE--Programmer's Reference, Revision C   **
10943C               **             Lahey Computer Systems, January, 1992**
10944C               **             PAGES 51 THRU 65                     **
10945C               ******************************************************
10946C
10947 4600 CONTINUE
10948      IF(ILAHSW.EQ.'OFF')THEN
10949        IX1=0
10950        IF(ILAHGR.EQ.'BIOS')THEN
10951          IX2=0
10952        ELSEIF(ILAHGR.EQ.'DIRE')THEN
10953          IX2=1
10954        ELSE
10955          IX2=1
10956        ENDIF
10957        IMODE=0
10958#ifdef HAVE_LAHEY_CALCOMP
10959        CALL PLOTS(IX1,IX2,IMODE)
10960#endif
10961        ILAHSW='ON'
10962      ELSE
10963        AX=0.0
10964        AY=0.0
10965        IPEN=-999
10966#ifdef HAVE_LAHEY_CALCOMP
10967        CALL PLOT(AX,AY,IPEN)
10968#endif
10969      ENDIF
10970#ifdef HAVE_LAHEY_CALCOMP
10971      CALL GRINFO(ILAHEY,RLAHEY,CLAHEY)
10972      ILAHNC=ILAHEY(4)
10973      ANUMHP=REAL(ILAHEY(1))
10974      ANUMVP=REAL(ILAHEY(2))
10975#endif
10976CCCCC FILL A RECTANGLE WITH THE COLOR
10977      PX(1)=0.0
10978      PX(2)=11.0
10979      PX(3)=11.0
10980      PX(4)=0.0
10981      PX(5)=0.0
10982      PY(1)=0.0
10983      PY(2)=0.0
10984      PY(3)=8.5
10985      PY(4)=8.5
10986      PY(5)=0.0
10987      NP=5
10988#ifdef HAVE_LAHEY_CALCOMP
10989      CALL NEWPEN(JCOL)
10990      CALL FILL(NP,PX,PY)
10991#endif
10992      ILAHCC=JCOL
10993      GOTO9000
10994C
10995C               ******************************************************
10996C               **  STEP 47--                                       **
10997C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
10998C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
10999C               ******************************************************
11000C
11001 4700 CONTINUE
11002C
11003CCCCC FEBRUARY 1995.  BE SURE TO SET FOCUS TO GRAPHICS SCREEN!
11004#ifdef HAVE_QWIN
11005      ISTATS=FOCUSQQ(99)
11006      IF(IQWNCL.EQ.'VGA')THEN
11007        ISTATS=SETBKCOLOR(JCOL)
11008      ELSEIF(IQWNCL.EQ.'RGB')THEN
11009        IF(JCOL.GE.0)THEN
11010          JTEMP=RGBTOINTEGER(IRED(JCOL),IGREEN(JCOL),IBLUE(JCOL))
11011          ISTATUS=SETBKCOLORRGB(JTEMP)
11012        ELSE
11013          AVAL=ABS(REAL(JCOL)/100.)*255.
11014          IVAL=INT(AVAL+0.5)
11015          IF(IVAL.LT.0)IVAL=0
11016          IF(IVAL.GT.255)IVAL=255
11017          JTEMP=IVAL
11018          JTEMP2=RGBTOINTEGER(JTEMP,JTEMP,JTEMP)
11019          ISTATUS=SETBKCOLORRGB(JTEMP2)
11020        ENDIF
11021      ELSE
11022        ISTATS=SETBKCOLOR(JCOL)
11023      ENDIF
11024      CALL CLEARSCREEN($GCLEARSCREEN)
11025#endif
11026      GOTO9000
11027C
11028C               ******************************************************
11029C               **  STEP 48--                                       **
11030C               **  TREAT THE OPEN-GL DRIVER                        **
11031C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
11032C               ******************************************************
11033C
11034 4800 CONTINUE
11035      IF(IOPGOF.EQ.'OFF')GOTO9000
11036#ifdef HAVE_OPEN_GL
11037      CALL GLCLEA
11038      CALL GLCHEC(IEXPOSE,IERRNO)
11039      IF(IERRNO.EQ.0)THEN
11040        GOTO4819
11041      ELSE
11042        WRITE(ICOUT,4821)
11043 4821   FORMAT(1X,'WARNING: OPEN-GL GRAPHICS WINDOW HAS BEEN DESTROYED.')
11044        CALL DPWRST('XXX','BUG ')
11045        IOPGOF='OFF'
11046        GOTO9000
11047      ENDIF
11048      IF(IEXPOSE.EQ.1)THEN
11049        IJUNK=0
11050        CALL GLUPDA(IJUNK)
11051      ENDIF
11052      IXTEMP = INT(ANUMHP+0.5)
11053      IYTEMP = INT(ANUMVP+0.5)
11054      IF(IORNSW.EQ.'LAND')THEN
11055        IORIEN=0
11056      ELSE IF(IORNSW.EQ.'PORT')THEN
11057        IORIEN=1
11058      ELSE IF(IORNSW.EQ.'SQUA')THEN
11059        IORIEN=3
11060      ELSE
11061        IORIEN=2
11062      END IF
11063      ATEMP=255.0
11064      ARED=REAL(IRED(JCOL))/ATEMP
11065      AGREEN=REAL(IGREEN(JCOL))/ATEMP
11066      ABLUE=REAL(IBLUE(JCOL))/ATEMP
11067      CALL GLERAS(IXTEMP,IYTEMP,IORIEN,IXPIX,IYPIX,ARED,AGREEN,ABLUE)
11068      ANUMHP=REAL(IXPIX)
11069      ANUMVP=REAL(IYPIX)
110704899  CONTINUE
11071#endif
11072      GOTO9000
11073C
11074C               ******************************************************
11075C               **  STEP 49--                                       **
11076C               **  TREAT THE LAHEY INTERACTOR CASE                 **
11077C               ******************************************************
11078C
11079 4900 CONTINUE
11080#ifdef HAVE_INTERACTER
11081      CALL IGrPaletteRGB(0,IRED(JCOL),IGREEN(JCOL),IBLUE(JCOL))
11082      CALL IgrColourN(0)
11083      CALL IGrArea(0.,1.,0.,1.)
11084      CALL IClearScreen()
11085      CALL IGrUnits(0.0,100.0,0.0,100.0)
11086#endif
11087      GOTO9000
11088C
11089C               ******************************************************
11090C               **  STEP 49B-                                       **
11091C               **  TREAT THE LAHEY WINTERACTOR CASE                **
11092C               ******************************************************
11093C
11094 4950 CONTINUE
11095#ifdef HAVE_WININTERACTER
11096      IF(IWINCL.EQ.'RGB')THEN
11097        CALL IGrPaletteRGB(0,IRED(JCOL),IGREEN(JCOL),IBLUE(JCOL))
11098        CALL IgrColourN(0)
11099      ELSE
11100        CALL IgrColourN(0)
11101      ENDIF
11102      CALL IGrArea(0.,1.,0.,1.)
11103      CALL IGrAreaClear()
11104#endif
11105      GOTO9000
11106C
11107C
11108C               ******************************************************
11109C               **  STEP 51--                                       **
11110C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
11111C               **  THERE IS NO    ERASE      INSTRUCTION PER SE.   **
11112C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
11113C               **             MODELS 3600SX AND 3653SX             **
11114C               **             PAGES B-0 AND B-1                    **
11115C               **  USE CALCOMP LIBRARY ROUTINES                    **
11116C               ******************************************************
11117C
11118 5100 CONTINUE
11119      IF(IZETSW.EQ.'OFF')THEN
11120        IPEN=-3
11121        YNEW=0.
11122        DOTPPI=1000.
11123        XPAGE=ANUMHP/DOTPPI
11124        XNEW=XPAGE+1.
11125#ifdef HAVE_ZETA
11126        CALL PLOT(XNEW,YNEW,IPEN)
11127#endif
11128      ENDIF
11129      IZETSW='OFF'
11130      GOTO9000
11131C
11132C               ******************************************************
11133C               **  STEP 66--                                       **
11134C               **  TREAT THE SUN CASE - WRITTEN BY BILL ANDERSON   **
11135C               **             PAGES 96 AND 145                     **
11136C               ******************************************************
11137C
11138 6600 CONTINUE
11139#ifdef HAVE_SUN
11140      CALL cfclrvws(ivsnam,0,0)
11141CCCCC CALL cfclosecgi()
11142#endif
11143      GOTO9000
11144C
11145C               ******************************************************
11146C               **  STEP 81--                                       **
11147C               **  TREAT THE DEC  REGIS CASE                       **
11148C               **  TO ERASE SCREEN---                              **
11149C               **  WRITE OUT AN ESC P p S ( E ) ESC \              **
11150C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
11151C               **             PAGES 96 AND 145                     **
11152C               **  JANUARY, 1991.  ADD SUPPORT FOR COLOR REGIS.    **
11153C               **  DEFINE COLOR MAP LOCATION TO 0, DEFINE BACKGROUND*
11154C               **  COLOR IN LOCATION 0.                            **
11155C               ******************************************************
11156C
11157 8100 CONTINUE
11158      IF(IGCOLO.EQ.'OFF')THEN
11159        ICSTR(1:1)=IESCC
11160        ICSTR(2:3)='Pp'
11161        ICSTR(4:7)='S(E)'
11162        NCSTR=7
11163        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11164      ELSE
11165        ICSTR(1:25)='S(M0(AH   L   S   ))S(I0)'
11166        NCHTOT=3
11167        ITEMP=IRGHUE(JCOL)
11168        NCSTR=7
11169        CALL GRTRIN(ITEMP,NCHTOT,ICSTR,NCSTR)
11170        ITEMP=IRGLGT(JCOL)
11171        NCSTR=11
11172        CALL GRTRIN(ITEMP,NCHTOT,ICSTR,NCSTR)
11173        ITEMP=IRGSAT(JCOL)
11174        NCSTR=15
11175        CALL GRTRIN(ITEMP,NCHTOT,ICSTR,NCSTR)
11176        ICSTR(26:26)=IESCC
11177        ICSTR(27:28)='Pp'
11178        ICSTR(29:32)='S(E)'
11179        NCSTR=32
11180        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11181      ENDIF
11182      GOTO9000
11183C
11184C               ******************************************************
11185C               **  STEP 86--                                       **
11186C               **  TREAT THE POSTSCRIPT CASE                       **
11187C               **  TO PRINT CURRENT PAGE - SHOWPAGE                **
11188C               **  ALSO SET NEW PAGE AS EITHER LANDSCAPE OR        **
11189C               **  PORTRAIT ORIENTATION.                           **
11190C               **  THE "GRESTORE/GSAVE" PAIR RESETS THE DEFAULT AND**
11191C               **  THE NEW "TRANSFORMATION" MATRIX IS DEFINED.     **
11192C               **  REFERENCE - POSTSCRIPT LANGUAGE TUTORIAL AND    **
11193C               **              COOKBOOK FROM ADOBE SYSTEMS         **
11194C               **  PAGE - 19                                       **
11195C               **  MODIFIED JANUARY, 1990.                         **
11196C               **  A) ADD CODE TO MAKE A "CONFORMING" POSTSCRIPT   **
11197C               **     FILE                                         **
11198C               **  B) SUPPORT ENCAPSULATED POSTSCRIPT.  NOTE THAT  **
11199C               **     FOR ENCAPSULATED POSTSCRIPT, EACH PAGE MUST  **
11200C               **     BE A SELF-CONTAINED FILE, SO EACH PAGE WILL  **
11201C               **     REPEAT WHAT WOULD NORMALLY BE IN THE GRINDE  **
11202C               **     GREXIT ROUTINES.                             **
11203C               ******************************************************
11204C
11205C  NOVEMBER 1990. BUG FIX.  MODIFY HOW MARGINS HANDLED.
11206C  OCTOBER  1991. MAKE FONTS TABLE DRIVEN (EASIER UPDATING, SIMPLER CODE)
11207C  JANUARY  1993. ONLY UPDATE PAGE NUMBER FOR DEVICE 2 (DEVICE 3
11208C                 ALWAYS 1).
11209C  JANUARY  1993. FOR "%%" LINES, CHECK FOR LEADING SPACE (FRAMEMAKER
11210C                 WON'T ACCEPT IF LEADING SPACE PRESENT).
11211C  OCTOBER  1993. FOR COLOR POSTSCRIPT, SET BACKGROUND COLOR.
11212C  JANUARY  2003: FOR REGULAR POSTSCRIPT, HAVE A CHECK FOR INITIAL PAGE
11213C                 ERASE (I.E., GRINDE DOES INITIAL PAGE, NO NEED TO
11214C                 REPEAT HERE).  THIS WILL SUPPRESS THE INITIAL BLANK
11215C                 PAGE.
11216C  JANUARY 1993:  ONLY COUNT PAGE FOR DEVICE 2.
11217C  JANUARY 2003:  IPSTNW USED TO ACCOUNT FOR INITIAL PAGE ERASE
11218C  DECEMBER 2009: SKIP A FEW LINES FOR DEVICE 3 POSTSCRIPT OUTPUT
11219C  NOVEMBER 2015: THE "SET DEVICE 3 <AUTOMATIC/USER>" COMMAND WAS ADDED
11220C                 TO SPECIFY WHETHER OR NOT DATAPLOT HANDLES
11221C                 OPENING/CLOSING OF DEVICE 3 AUTOMATICALLY (SO THAT
11222C                 DEVICE 3 OUTPUT CONTAINS MOST RECENT GRAPH).
11223C
11224 8600 CONTINUE
11225      IF(IMODE3.NE.'DEV3')THEN
11226        IF(IGUNIT.EQ.IPL1NU)THEN
11227          IF(IPSTNW.EQ.'ON')THEN
11228            IPSTNW='OFF'
11229            IF(IMODEL.EQ.'ENCA')GOTO8710
11230            GOTO9000
11231          ELSE
11232            IPSTPN=IPSTPN+1
11233          ENDIF
11234        ELSEIF(IGUNIT.EQ.IPL2NU)THEN
11235          IF(IPSTN2.EQ.'ON')THEN
11236            IPSTN2='OFF'
11237            IF(IMODEL.EQ.'ENCA')GOTO8710
11238            GOTO9000
11239          ELSE
11240            IPSTP2=IPSTP2+1
11241          ENDIF
11242        ENDIF
11243      ENDIF
11244CCCCC END CHANGE
11245CCCCC JANUARY 1993.  ADD FOLLOWING LINE
11246      IF(IPSTSP.EQ.'OFF'.OR.IPSTSP.EQ.'NO'.OR.IPSTSP.EQ.'FALS')
11247     1 IPSTSP='OFF'
11248CCCCC ENCAPSULATED POSTSCRIPT HANDLED DIFFERENTLY
11249      IF(IMODEL.EQ.'ENCA')GOTO8710
11250C
11251CCCCC THE FOLLOWING 12 LINES WERE ADDED MAY 1992 (JJF)
11252CCCCC IF(IPSTBP.EQ.'ON'.OR.IPSTPN.GE.3)THEN
11253CCCCC IF(IMODE3.NE.'DEV3'.AND.IPSTPN.GE.3)THEN
11254      IF(IMODE3.NE.'DEV3')THEN
11255        IF(IGUNIT.EQ.IPL1NU)THEN
11256          IF(IDV2SP.EQ.'OFF')THEN
11257            ICSTR(1:8)='showpage'
11258            NCSTR=8
11259            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11260          ELSE
11261            IF(IPSTBP.EQ.'ON')THEN
11262              ICSTR(1:8)='showpage'
11263              NCSTR=8
11264              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11265            ENDIF
11266          ENDIF
11267        ELSEIF(IGUNIT.EQ.IPL2NU)THEN
11268CCCCC     IF(IPSTBP.EQ.'ON')THEN
11269             ICSTR(1:8)='showpage'
11270             NCSTR=8
11271             CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11272CCCCC     ENDIF
11273        ENDIF
11274      ELSE
11275        IF(IPSTBP.EQ.'ON')THEN
11276          ICSTR(1:8)='showpage'
11277          NCSTR=8
11278          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11279        ENDIF
11280      ENDIF
11281C
11282CCCCC DECEMBER 2009: FOR DEVICE 3 OUTPUT, OMIT THE NEXT FEW LINES AS
11283CCCCC                THESE ARE DONE IN GRINDE (TO ACCOUNT FOR
11284CCCCC                DIAGRAMMATIC GRAPHICS FOR DEVICE 3 OUTPUT).
11285C
11286      IF(IMODE3.NE.'DEV3')THEN
11287        ICSTR(1:8)='grestore'
11288        NCSTR=8
11289        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11290C       FOLLOWING SECTION ADDED JANUARY, 1990
11291        ICSTR(1:8)='%%Page: '
11292        NCHTOT=5
11293        NCSTR=8
11294CCCCC   JANUARY 1993.  ADD FOLLOWING LINE
11295        IVALT=IPSTPN
11296        IF(IGUNIT.EQ.IPL2NU)IVALT=IPSTP2
11297        CALL GRTRIN(IVALT,NCHTOT,ICSTR,NCSTR)
11298        NCSTR=NCSTR+1
11299        ICSTR(NCSTR:NCSTR)=' '
11300        CALL GRTRIN(IVALT,NCHTOT,ICSTR,NCSTR)
11301        IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11302        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11303C
11304        ICSTR(1:5)='gsave'
11305        NCSTR=5
11306        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11307C
11308        ICSTR(1:11)='0 0 moveto '
11309        NCSTR=11
11310        XPPI=PSTPPI
11311        YPPI=PSTPPI
11312        XSCALE=72./XPPI
11313        YSCALE=72./YPPI
11314        NCSTR=11
11315        NCHTOT=10
11316        NCHDEC=5
11317        CALL GRTRRE(XSCALE,NCHTOT,NCHDEC,ICSTR,NCSTR)
11318        ICSTR(22:22)=' '
11319        NCSTR=22
11320        CALL GRTRRE(YSCALE,NCHTOT,NCHDEC,ICSTR,NCSTR)
11321        ICSTR(33:39)=' scale '
11322        NCSTR=39
11323C
11324CCCCC   IXTR=IOFFSH
11325CCCCC   IYTR=IOFFSV
11326CCCCC   IF(IORNSW.NE.'PORT')IXTR=IOFFSH+ANUMVP+0.5
11327        IF(IORNSW.EQ.'LAND')THEN
11328          IVTEMP=IPSTBM
11329          IHTEMP=IPSTLM
11330        ELSEIF(IORNSW.EQ.'LAN2')THEN
11331          IVTEMP=IPS2BM
11332          IHTEMP=IPS2LM
11333        ELSEIF(IORNSW.EQ.'PORT')THEN
11334          IVTEMP=IPS2BM
11335          IHTEMP=IPS2LM
11336        ELSEIF(IORNSW.EQ.'SQUA')THEN
11337          IVTEMP=IPS2BM
11338          IHTEMP=IPS2LM
11339        ELSE
11340          IVTEMP=IPSTBM
11341          IHTEMP=IPSTLM
11342        END IF
11343        IXTR=IHTEMP
11344        IYTR=IVTEMP
11345        IF(IORNSW.NE.'PORT' .AND. IORNSW.NE.'LAN2' .AND.
11346     1    IORNSW.NE.'SQUA')IXTR=IHTEMP+INT(ANUMVP+0.5)
11347        NCHTOT=5
11348        CALL GRTRIN(IXTR,NCHTOT,ICSTR,NCSTR)
11349        ICSTR(45:45)=' '
11350        NCSTR=45
11351        CALL GRTRIN(IYTR,NCHTOT,ICSTR,NCSTR)
11352        ICSTR(51:61)=' translate '
11353C
11354        ICSTR(62:63)=' 0'
11355        IF(IORNSW.NE.'PORT' .AND. IORNSW.NE.'LAN2' .AND.
11356     1    IORNSW.NE.'SQUA')ICSTR(62:63)='90'
11357        ICSTR(64:71)=' rotate '
11358        NCSTR=71
11359        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11360      ENDIF
11361C
11362C  NOTE: NEW PAGE DOES A RESTORE, WHICH SETS INITIAL FONT SIZE
11363C        SO SET CURRENT FONT SIZE TO ORIGINAL FONT SIZE
11364      IPSTPC=IPSTPO
11365C  JUNE, 1989.  A NEW PAGE RESETS THE FONT TO WHAT IS SET IN GRINDE.
11366C  ADDED IPSTFO TO DPCODV COMMON BLOCK.
11367      IPSTFC=IPSTFO
11368CCCCC OCTOBER 1993.  FILL BACKGROUND FOR COLOR POSTSCRIPT.
11369CCCCC NOTE THAT THIS WILL ONLY BE DONE FOR COLOR POSTSCRIPT DEVICES
11370      IF(IGCOLO.NE.'ON')GOTO9000
11371CCCCC SET A GREYSCALE COLOR
11372      IF(JCOL.LT.0)THEN
11373        AVAL=REAL(JCOL)/100.
11374        AVAL=ABS(AVAL)
11375        IF(AVAL.LE.0.0)AVAL=0.0
11376        IF(AVAL.GE.1.0)AVAL=1.0
11377        NCSTR=0
11378        NCHTOT=7
11379        NCHDEC=5
11380        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
11381        NCSTR=NCSTR+1
11382        ICSTR(NCSTR:NCSTR)=' '
11383        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
11384        NCSTR=NCSTR+1
11385        ICSTR(NCSTR:NCSTR)=' '
11386        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
11387        NCSTR=NCSTR+1
11388        ICSTR(NCSTR:NCSTR)=' '
11389        NCSTR=NCSTR+1
11390        NCSTR2=NCSTR+10
11391        ICSTR(NCSTR:NCSTR2)='setrgbcolor'
11392        NCSTR=NCSTR2
11393        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11394CCCCC SET A NON-GRAY SCALE COLOR
11395      ELSE
11396        AVAL=REAL(IRED(JCOL))/255.
11397        NCSTR=0
11398        NCHTOT=7
11399        NCHDEC=5
11400        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
11401        NCSTR=NCSTR+1
11402        ICSTR(NCSTR:NCSTR)=' '
11403        AVAL=REAL(IGREEN(JCOL))/255.
11404        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
11405        NCSTR=NCSTR+1
11406        ICSTR(NCSTR:NCSTR)=' '
11407        AVAL=REAL(IBLUE(JCOL))/255.
11408        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
11409        NCSTR=NCSTR+1
11410        ICSTR(NCSTR:NCSTR)=' '
11411        NCSTR=NCSTR+1
11412        NCSTR2=NCSTR+10
11413        ICSTR(NCSTR:NCSTR2)='setrgbcolor'
11414        NCSTR=NCSTR2
11415        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11416      ENDIF
11417CCCCC FILL A RECTANGLE WITH THE COLOR
11418      PX(1)=0.
11419      PX(2)=100.
11420      PX(3)=100.
11421      PX(4)=0.
11422      PX(5)=0.
11423      PY(1)=0.
11424      PY(2)=0.
11425      PY(3)=100.
11426      PY(4)=100.
11427      PY(5)=0.
11428      NP=5
11429      NCHTOT=5
11430      NCSTR=0
11431      CALL GRTRSD(PX(1),PY(1),IX,IY,ISUBN0)
11432      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
11433      ICSTR(6:6)=' '
11434      NCSTR=6
11435      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
11436      ICSTR(12:13)=' m'
11437      NCSTR=13
11438      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11439      DO8811I=2,NP
11440      NCSTR=0
11441      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
11442      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
11443      ICSTR(6:6)=' '
11444      NCSTR=6
11445      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
11446      ICSTR(12:13)=' l'
11447      NCSTR=13
11448      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11449 8811 CONTINUE
11450      ICSTR(1:35)='closepath fill 0. 0. 0. setrgbcolor'
11451      NCSTR=35
11452      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11453C
11454      GOTO9000
11455C
11456C  JANUARY, 1990.  ADD CODE FOR ENCAPSULATED POSTSCRIPT.  NOTE THAT EACH
11457C  PAGE MUST BE SELF-CONTAINED, SO MIMIC CODE FROM GREXIT AND GRINDE USED
11458C  BY REGULAR POSTSCRIPT.
11459C
11460 8710 CONTINUE
11461      IVALT=IPSTPN
11462      IF(IMODE3.NE.'DEV3')THEN
11463        IVALT=IPSTPN
11464        IF(IGUNIT.EQ.IPL2NU)IVALT=IPSTP2
11465      ENDIF
11466      IF(IVALT.LE.1)GOTO8719
11467      ICSTR(1:8)='showpage'
11468      NCSTR=8
11469      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11470      ICSTR(1:3)='end'
11471      NCSTR=3
11472      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11473      ICSTR(1:8)='grestore'
11474      NCSTR=8
11475      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11476      ICSTR(1:9)='%%Trailer'
11477      NCSTR=9
11478      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11479      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11480      ICSTR(1:33)='% END OF DATAPLOT POSTSCRIPT PAGE'
11481      NCSTR=33
11482      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11483C
11484CCCCC JANUARY 1993.  CHECK FOR LEADING SPACE ON "%%" LINES
11485 8719 CONTINUE
11486      ICSTR(1:23)='%!PS-Adobe-2.0 EPSF-1.2'
11487      NCSTR=23
11488      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11489      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11490      ICSTR(1:19)='%%Creator: Dataplot'
11491      NCSTR=19
11492      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11493      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11494      ICSTR(1:46)='%%Title: Dataplot Encapsulated Postscript File'
11495      NCSTR=46
11496      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11497      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11498      ICSTR(1:20)='%%CreationDate: NULL'
11499      NCSTR=20
11500      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11501      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11502      ICSTR(1:40)='%%DocumentFonts: Times-Roman Times-Bold '
11503      ICSTR(41:69)='Times-Italic Times-BoldItalic'
11504      NCSTR=69
11505      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11506      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11507      ICSTR(1:46)='%%+ Helvetica Helvetica-Bold Helvetica-Oblique'
11508      ICSTR(47:76)=' Helvetica-BoldOblique Courier'
11509      NCSTR=76
11510      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11511      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11512      ICSTR(1:33)='%%+ Courier-Bold Courier-Oblique '
11513      ICSTR(34:53)=' Courier-BoldOblique'
11514      NCSTR=53
11515      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11516      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11517C  OCTOBER 1991.  ADDITIONAL FONTS ADDED
11518      ICSTR(1:42)='%%+ AvantGarde-Book AvantGarde-BookOblique'
11519      ICSTR(43:81)=' AvantGarde-Demi AvantGarde-DemiOblique'
11520      NCSTR=81
11521      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11522      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11523      ICSTR(1:42)='%%+ Bookman-Demi Bookman-DemiItalic       '
11524      ICSTR(43:81)='Bookman-Light Bookman-LightItalic      '
11525      NCSTR=81
11526      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11527      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11528      ICSTR(1:42)='%%+ Helvetica-Narrow Helvetica-Narrow-Bold'
11529      ICSTR(43:81)=' Helvetica-Narrow-BoldOblique          '
11530      NCSTR=81
11531      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11532      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11533      ICSTR(1:42)='%%+ Helvetica-Narrow-Oblique              '
11534      ICSTR(43:81)='NewCentury-Schlbk-Bold                 '
11535      NCSTR=81
11536      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11537      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11538      ICSTR(1:42)='%%+ NewCentury-Schlbk-Italic              '
11539      ICSTR(43:81)='NewCenturySchlbk-BoldItalic            '
11540      NCSTR=81
11541      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11542      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11543      ICSTR(1:42)='%%+ Palatino-Roman Palatino-Bold          '
11544      ICSTR(43:81)='Palatino-Italic Palatino-BoldItalic    '
11545      NCSTR=81
11546      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11547      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11548      ICSTR(1:42)='%%+ ZapfChancery-Medium Italic Symbol     '
11549      ICSTR(43:81)='                                       '
11550      NCSTR=81
11551      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11552      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11553C  END CHANGE
11554C  JANUARY 1993.  FOLLOWING 9 LINES MOVED
11555CCCCC ICSTR(1:48)='% BoundingBox given in Postscript default units '
11556CCCCC ICSTR(49:75)='(72 ppi), accomodate either'
11557CCCCC NCSTR=75
11558CCCCC IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11559CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11560CCCCC ICSTR(1:41)='% portrait or landscape mode at 11 inches'
11561CCCCC NCSTR=41
11562CCCCC IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11563CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11564CCCCC NOVEMBER 1996.  FOLLOWING SECTION MODIFIED TO BASE BOUNDING BOX
11565CCCCC ON WHETHER OR NOT USE LANDSCAPE, PORTRAIT, OR LANDSCAPE
11566CCCCC WORDPERFECT (LAN2) MODE USED.
11567      IF(IORNSW.EQ.'PORT')THEN
11568        ICSTR(1:26)='%%BoundingBox: 0 0 612 792'
11569        NCSTR=26
11570      ELSEIF(IORNSW.EQ.'LAND')THEN
11571        ICSTR(1:26)='%%BoundingBox: 0 0 792 612'
11572        NCSTR=26
11573      ELSEIF(IORNSW.EQ.'LAN2')THEN
11574        ICSTR(1:26)='%%BoundingBox: 0 0 612 468'
11575        NCSTR=26
11576      ELSEIF(IORNSW.EQ.'SQUA')THEN
11577        ICSTR(1:26)='%%BoundingBox: 0 0 612 612'
11578        NCSTR=26
11579      ELSE
11580        ICSTR(1:26)='%%BoundingBox: 0 0 792 792'
11581        NCSTR=26
11582      ENDIF
11583CCCCC NCHTOT=5
11584CCCCC IJUNK=11*72
11585CCCCC CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
11586CCCCC NCSTR=NCSTR+1
11587CCCCC ICSTR(NCSTR:NCSTR)=' '
11588CCCCC CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
11589      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11590      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11591      ICSTR(1:13)='%%EndComments'
11592      NCSTR=13
11593      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11594      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11595CCCCC JANUARY 1993.  FOLLOWING 9 LINES MOVED HERE.
11596CCCCC NOVEMBER 1996.  FOLLOWING SECTION COMMENTED OUT
11597CCCCC ICSTR(1:48)='% BoundingBox given in Postscript default units '
11598CCCCC ICSTR(49:75)='(72 ppi), accomodate either'
11599CCCCC NCSTR=75
11600CCCCC IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11601CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11602CCCCC ICSTR(1:41)='% portrait or landscape mode at 11 inches'
11603CCCCC NCSTR=41
11604CCCCC IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11605CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11606C
11607      ICSTR(1:43)='% DATAPLOT POSTSCRIPT DRIVER, JANUARY, 1990'
11608      NCSTR=43
11609      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11610      ICSTR(1:43)='% PROLOG SECTION: DATAPLOT DEFINITIONS     '
11611      NCSTR=43
11612      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11613      ICSTR(1:13)='15 dict begin'
11614      NCSTR=13
11615      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11616      ICSTR(1:43)='% REDEFINE "showpage" TO BE A NULL OPERATOR'
11617      NCSTR=43
11618      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11619      ICSTR(1:16)='/showpage {} def'
11620      NCSTR=16
11621      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11622C
11623      ICSTR(1:44)='%DEFINE PROCEDURE "rightshow" TO PRINT RIGHT'
11624      ICSTR(45:72)=' JUSTIFIED STRING.  CALL BY:'
11625      NCSTR=72
11626      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11627      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
11628      NCSTR=35
11629      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11630      ICSTR(1:20)='% (STRING) rightshow'
11631      NCSTR=20
11632      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11633      ICSTR(1:10)='/rightshow'
11634      NCSTR=10
11635      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11636      ICSTR(1:22)='  {dup stringwidth pop'
11637      NCSTR=22
11638      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11639      ICSTR(1:14)='   IX exch sub'
11640      NCSTR=14
11641      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11642      ICSTR(1:12)='   IY moveto'
11643      NCSTR=12
11644      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11645      ICSTR(1:12)='   show} def'
11646      NCSTR=12
11647      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11648C
11649      ICSTR(1:44)='%DEFINE PROCEDURE "centshow" TO PRINT CENTER'
11650      ICSTR(45:72)=' JUSTIFIED STRING.  CALL BY:'
11651      NCSTR=72
11652      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11653      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
11654      NCSTR=35
11655      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11656      ICSTR(1:19)='% (STRING) centshow'
11657      NCSTR=19
11658      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11659      ICSTR(1:9)='/centshow'
11660      NCSTR=9
11661      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11662      ICSTR(1:22)='  {dup stringwidth pop'
11663      NCSTR=22
11664      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11665      ICSTR(1:8)='   2 div'
11666      NCSTR=8
11667      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11668      ICSTR(1:14)='   IX exch sub'
11669      NCSTR=14
11670      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11671      ICSTR(1:12)='   IY moveto'
11672      NCSTR=12
11673      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11674      ICSTR(1:12)='   show} def'
11675      NCSTR=12
11676      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11677C
11678      ICSTR(1:44)='%DEFINE PROCEDURE "leftshow" TO PRINT LEFT  '
11679      ICSTR(45:72)=' JUSTIFIED STRING.  CALL BY:'
11680      NCSTR=72
11681      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11682      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
11683      NCSTR=35
11684      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11685      ICSTR(1:19)='% (STRING) leftshow'
11686      NCSTR=19
11687      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11688      ICSTR(1:9)='/leftshow'
11689      NCSTR=9
11690      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11691      ICSTR(1:25)='  {IX IY moveto show} def'
11692      NCSTR=25
11693      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11694C
11695      ICSTR(1:45)='%DEFINE PROCEDURE "vrightshow" TO PRINT RIGHT'
11696      ICSTR(46:82)=' JUSTIFIED VERTICAL STRING.  CALL BY:'
11697      NCSTR=82
11698      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11699      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
11700      NCSTR=35
11701      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11702      ICSTR(1:28)='% newpath IX IY moveto gsave'
11703      NCSTR=28
11704      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11705      ICSTR(1:30)='% (STRING) vrightshow grestore'
11706      NCSTR=30
11707      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11708      ICSTR(1:11)='/vrightshow'
11709      NCSTR=11
11710      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11711      ICSTR(1:22)='  {dup stringwidth pop'
11712      NCSTR=22
11713      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11714      ICSTR(1:14)='   IY exch sub'
11715      NCSTR=14
11716      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11717      ICSTR(1:17)='   IX exch moveto'
11718      NCSTR=17
11719      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11720      ICSTR(1:13)='    90 rotate'
11721      NCSTR=13
11722      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11723      ICSTR(1:12)='   show} def'
11724      NCSTR=12
11725      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11726C
11727      ICSTR(1:45)='%DEFINE PROCEDURE "vcentshow" TO PRINT CENTER'
11728      ICSTR(46:82)=' JUSTIFIED VERTICAL STRING.  CALL BY:'
11729      NCSTR=82
11730      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11731      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
11732      NCSTR=35
11733      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11734      ICSTR(1:28)='% newpath IX IY moveto gsave'
11735      NCSTR=28
11736      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11737      ICSTR(1:29)='% (STRING) vcentshow grestore'
11738      NCSTR=29
11739      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11740      ICSTR(1:10)='/vcentshow'
11741      NCSTR=10
11742      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11743      ICSTR(1:22)='  {dup stringwidth pop'
11744      NCSTR=22
11745      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11746      ICSTR(1:8)='   2 div'
11747      NCSTR=8
11748      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11749      ICSTR(1:14)='   IY exch sub'
11750      NCSTR=14
11751      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11752      ICSTR(1:17)='   IX exch moveto'
11753      NCSTR=17
11754      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11755      ICSTR(1:14)='     90 rotate'
11756      NCSTR=14
11757      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11758      ICSTR(1:12)='   show} def'
11759      NCSTR=12
11760      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11761C
11762      ICSTR(1:45)='%DEFINE PROCEDURE "vleftshow" TO PRINT LEFT  '
11763      ICSTR(46:82)=' JUSTIFIED VERTICAL STRING.  CALL BY:'
11764      NCSTR=82
11765      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11766      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
11767      NCSTR=35
11768      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11769      ICSTR(1:28)='% newpath IX IY moveto gsave'
11770      NCSTR=28
11771      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11772      ICSTR(1:29)='% (STRING) vleftshow grestore'
11773      NCSTR=29
11774      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11775      ICSTR(1:10)='/vleftshow'
11776      NCSTR=10
11777      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11778      ICSTR(1:36)='  {IX IY moveto 90 rotate show} def'
11779      NCSTR=36
11780      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11781C
11782      ICSTR(1:52)='% DEFINE PROCEDURE "l" AS ABBREVIATION OF lineto'
11783      NCSTR=52
11784      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11785      ICSTR(1:15)='/l {lineto} def'
11786      NCSTR=15
11787      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11788      ICSTR(1:52)='% DEFINE PROCEDURE "m" AS ABBREVIATION OF moveto'
11789      NCSTR=52
11790      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11791      ICSTR(1:15)='/m {moveto} def'
11792      NCSTR=15
11793      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11794      APOINT=ANUMVP*2.0/100.
11795      IPOINT=INT(APOINT)
11796C  FOLLOWING CODE MODIFIED OCTOBER 1991.
11797      IJUNK=7
11798      DO8695I=1,IPSTMF
11799        IF(IPSTFN.NE.IPSTT1(I))GOTO8695
11800        IJUNK=I
11801        GOTO8697
11802 8695 CONTINUE
11803 8697 CONTINUE
11804      ICSTR(1:1)='/'
11805      ICSTR(2:41)=IPSTT2(IJUNK)(1:40)
11806      ICSTR(42:51)=' findfont '
11807      NCHTOT=3
11808      NCSTR=51
11809      CALL GRTRIN(IPOINT,NCHTOT,ICSTR,NCSTR)
11810      NCSTR=NCSTR+1
11811      NCSTR2=NCSTR+17
11812      ICSTR(NCSTR:NCSTR2)=' scalefont setfont'
11813      NCSTR=NCSTR2
11814      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11815CCCCC ICSTR(1:33)='/Times-Roman            findfont '
11816CCCCC IF(IPSTFN.EQ.'TBOL')
11817CCCCC1ICSTR(1:23)='/Times-Bold            '
11818CCCCC IF(IPSTFN.EQ.'TITA')
11819CCCCC1ICSTR(1:23)='/Times-Italic          '
11820CCCCC IF(IPSTFN.EQ.'TBIT')
11821CCCCC1ICSTR(1:23)='/Times-BoldItalic      '
11822CCCCC IF(IPSTFN.EQ.'HELV')
11823CCCCC1ICSTR(1:23)='/Helvetica             '
11824CCCCC IF(IPSTFN.EQ.'HELB')
11825CCCCC1ICSTR(1:23)='/Helvetica-Bold        '
11826CCCCC IF(IPSTFN.EQ.'HELO')
11827CCCCC1ICSTR(1:23)='/Helvetica-Oblique     '
11828CCCCC IF(IPSTFN.EQ.'HEBO')
11829CCCCC1ICSTR(1:23)='/Helvetica-BoldOblique '
11830CCCCC IF(IPSTFN.EQ.'COUR')
11831CCCCC1ICSTR(1:23)='/Courier               '
11832CCCCC IF(IPSTFN.EQ.'CBOL')
11833CCCCC1ICSTR(1:23)='/Courier-Bold          '
11834CCCCC IF(IPSTFN.EQ.'COBL')
11835CCCCC1ICSTR(1:23)='/Courier-Oblique       '
11836CCCCC IF(IPSTFN.EQ.'CBOB')
11837CCCCC1ICSTR(1:23)='/Courier-BoldOblique   '
11838CCCCC NCSTR=33
11839CCCCC NCHTOT=3
11840CCCCC CALL GRTRIN(IPOINT,NCHTOT,ICSTR,NCSTR)
11841CCCCC ICSTR(37:54)=' scalefont setfont'
11842CCCCC NCSTR=54
11843CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11844C
11845C  END CHANGE
11846      IPSTFC=IPSTFN
11847      IPSTPS=IPOINT
11848      IPSTPC=IPOINT
11849      IPSTPO=IPOINT
11850      IPSTFO=IPSTFN
11851C
11852      ICSTR(1:41)='gsave    % SAVE INITIAL GRAPHICS STATE'
11853      NCSTR=41
11854      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11855C  ADD FOLLOWING LINES JANUARY, 1990.
11856      ICSTR(1:11)='%%EndProlog'
11857      NCSTR=11
11858CCCCC JANUARY 1993.  ADD FOLLOWING LINE
11859      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
11860      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11861      ICSTR(1:11)='0 0 moveto '
11862      NCSTR=11
11863      XPPI=PSTPPI
11864      YPPI=PSTPPI
11865      XSCALE=72./XPPI
11866      YSCALE=72./YPPI
11867      NCSTR=11
11868      NCHTOT=10
11869      NCHDEC=5
11870      CALL GRTRRE(XSCALE,NCHTOT,NCHDEC,ICSTR,NCSTR)
11871      ICSTR(22:22)=' '
11872      NCSTR=22
11873      CALL GRTRRE(YSCALE,NCHTOT,NCHDEC,ICSTR,NCSTR)
11874      ICSTR(33:39)=' scale '
11875      NCSTR=39
11876C
11877      IF(IORNSW.EQ.'LAND')THEN
11878        IVTEMP=IPSTBM
11879        IHTEMP=IPSTLM
11880      ELSEIF(IORNSW.EQ.'LAN2')THEN
11881        IVTEMP=IPS2BM
11882        IHTEMP=IPS2LM
11883      ELSEIF(IORNSW.EQ.'PORT')THEN
11884        IVTEMP=IPS2BM
11885        IHTEMP=IPS2LM
11886      ELSEIF(IORNSW.EQ.'SQUA')THEN
11887        IVTEMP=IPS2BM
11888        IHTEMP=IPS2LM
11889      ELSE
11890        IVTEMP=IPSTBM
11891        IHTEMP=IPSTLM
11892      END IF
11893      IXTR=IHTEMP
11894      IYTR=IVTEMP
11895      IF(IORNSW.NE.'PORT' .AND. IORNSW.NE.'LAN2' .AND. IORNSW.NE.'SQUA')
11896     1IXTR=IHTEMP+INT(ANUMVP+0.5)
11897      NCHTOT=5
11898      CALL GRTRIN(IXTR,NCHTOT,ICSTR,NCSTR)
11899      ICSTR(45:45)=' '
11900      NCSTR=45
11901      CALL GRTRIN(IYTR,NCHTOT,ICSTR,NCSTR)
11902      ICSTR(51:61)=' translate '
11903C
11904      ICSTR(62:63)=' 0'
11905      IF(IORNSW.NE.'PORT' .AND. IORNSW.NE.'LAN2' .AND. IORNSW.NE.'SQUA')
11906     1ICSTR(62:63)='90'
11907      ICSTR(64:71)=' rotate '
11908      NCSTR=71
11909      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11910C
11911CCCCC OCTOBER 1993.  FILL BACKGROUND FOR COLOR POSTSCRIPT.
11912CCCCC NOTE THAT THIS WILL ONLY BE DONE FOR COLOR POSTSCRIPT DEVICES
11913      IF(IGCOLO.NE.'ON')GOTO9000
11914CCCCC SET A GREYSCALE COLOR
11915      IF(JCOL.LT.0)THEN
11916        AVAL=REAL(JCOL)/100.
11917        AVAL=ABS(AVAL)
11918        IF(AVAL.LE.0.0)AVAL=0.0
11919        IF(AVAL.GE.1.0)AVAL=1.0
11920        NCSTR=0
11921        NCHTOT=7
11922        NCHDEC=5
11923        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
11924        NCSTR=NCSTR+1
11925        ICSTR(NCSTR:NCSTR)=' '
11926        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
11927        NCSTR=NCSTR+1
11928        ICSTR(NCSTR:NCSTR)=' '
11929        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
11930        NCSTR=NCSTR+1
11931        ICSTR(NCSTR:NCSTR)=' '
11932        NCSTR=NCSTR+1
11933        NCSTR2=NCSTR+10
11934        ICSTR(NCSTR:NCSTR2)='setrgbcolor'
11935        NCSTR=NCSTR2
11936        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11937CCCCC SET A NON-GRAY SCALE COLOR
11938      ELSE
11939        AVAL=REAL(IRED(JCOL))/255.
11940        NCSTR=0
11941        NCHTOT=7
11942        NCHDEC=5
11943        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
11944        NCSTR=NCSTR+1
11945        ICSTR(NCSTR:NCSTR)=' '
11946        AVAL=REAL(IGREEN(JCOL))/255.
11947        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
11948        NCSTR=NCSTR+1
11949        ICSTR(NCSTR:NCSTR)=' '
11950        AVAL=REAL(IBLUE(JCOL))/255.
11951        CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
11952        NCSTR=NCSTR+1
11953        ICSTR(NCSTR:NCSTR)=' '
11954        NCSTR=NCSTR+1
11955        NCSTR2=NCSTR+10
11956        ICSTR(NCSTR:NCSTR2)='setrgbcolor'
11957        NCSTR=NCSTR2
11958        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11959      ENDIF
11960CCCCC FILL A RECTANGLE WITH THE COLOR
11961      PX(1)=0.
11962      PX(2)=100.
11963      PX(3)=100.
11964      PX(4)=0.
11965      PX(5)=0.
11966      PY(1)=0.
11967      PY(2)=0.
11968      PY(3)=100.
11969      PY(4)=100.
11970      PY(5)=0.
11971      NP=5
11972      NCHTOT=5
11973      NCSTR=0
11974      CALL GRTRSD(PX(1),PY(1),IX,IY,ISUBN0)
11975      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
11976      ICSTR(6:6)=' '
11977      NCSTR=6
11978      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
11979      ICSTR(12:13)=' m'
11980      NCSTR=13
11981      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11982      DO8911I=2,NP
11983      NCSTR=0
11984      CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0)
11985      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
11986      ICSTR(6:6)=' '
11987      NCSTR=6
11988      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
11989      ICSTR(12:13)=' l'
11990      NCSTR=13
11991      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11992 8911 CONTINUE
11993      ICSTR(1:35)='closepath fill 0. 0. 0. setrgbcolor'
11994      NCSTR=35
11995      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
11996C
11997      GOTO9000
11998C
11999C
12000C               ******************************************************
12001C               **  STEP 91--                                       **
12002C               **  TREAT THE QUIC       CASE                       **
12003C               **  TO PRINT CURRENT PAGE - "^,"                    **
12004C               **  REFERENCE - QUIC PROGRAMMING MANUAL             **
12005C               **  PAGES 5-10, 5-11
12006C               ******************************************************
12007C
12008 9100 CONTINUE
12009      CALL DPCONA(94,ICARAT)
12010      ICSTR(1:1)=ICARAT
12011      ICSTR(2:2)=','
12012      NCSTR=2
12013      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12014      GOTO9000
12015C
12016C               ******************************************************
12017C               **  STEP 95--                                       **
12018C               **  TREAT THE X11        CASE                       **
12019C               **  1) CLEAR THE BUFFER (TO FINISH CURRENT PLOT)    **
12020C               **     AND OPTIONALLY WAIT FOR CARRIAGE RETURN      **
12021C               **  2) CHECK THE "INPUT" BUFFER FOR CONFIG AND      **
12022C               **     WINDOW EVENTS                                **
12023C               **  3) CLEAR THE WINDOW                             **
12024C               ******************************************************
12025C
12026 9600 CONTINUE
12027      IF(IX11OF.EQ.'OFF')GOTO9000
12028#ifdef HAVE_X11
12029      CALL XCLEAR
12030      IF(IX11PA.EQ.'ON')THEN
12031CCCCC   WRITE(ICOUT,9605)
12032C9605   FORMAT('PRESS CARRIAGE RETURN TO CONTINUE:')
12033CCCCC   CALL DPWRST('XXX','BUG ')
12034CCCCC   READ(IRD,'(A1)')IA
12035      ENDIF
12036      CALL XCHECK(IEXPOSE,IERRNO)
12037      IF(IERRNO.NE.0)THEN
12038        WRITE(ICOUT,9621)
12039 9621   FORMAT(1X,'WARNING: X11 GRAPHICS WINDOW HAS BEEN DESTROYED.')
12040        CALL DPWRST('XXX','BUG ')
12041        IX11OF='OFF'
12042        GOTO9000
12043      ENDIF
12044      IF(IEXPOSE.EQ.1 .AND. IX11PM.EQ.'ON')THEN
12045        IJUNK=0
12046        CALL XUPDAT(IJUNK)
12047      ENDIF
12048      IXTEMP = INT(ANUMHP+0.5)
12049      IYTEMP = INT(ANUMVP+0.5)
12050      IF(IORNSW.EQ.'LAND')THEN
12051        IORIEN=0
12052      ELSE IF(IORNSW.EQ.'PORT')THEN
12053        IORIEN=1
12054      ELSE IF(IORNSW.EQ.'SQUA')THEN
12055        IORIEN=3
12056      ELSE
12057        IORIEN=2
12058      END IF
12059      IPIX=0
12060      IF(IX11PM.EQ.'ON')IPIX=1
12061      CALL XERASE(IXTEMP,IYTEMP,IORIEN,IXPIX,IYPIX,JCOL,IPIX)
12062      ANUMHP=REAL(IXPIX)
12063      ANUMVP=REAL(IYPIX)
12064      NUMHPP=INT(ANUMHP+0.1)
12065      NUMVPP=INT(ANUMVP+0.1)
12066#endif
12067      GOTO9000
12068C
12069C               *************************************************
12070C               **  STEP 100--                                 **
12071C               **  TREAT THE VGA VIA TURBO-C       CASE       **
12072C               *************************************************
12073C
12074CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
1207510000 CONTINUE
12076CTURB CALL TCERSC(ICOLT)
12077      GOTO9000
12078C
12079C               ******************************************************
12080C               **  STEP 110--                                      **
12081C               **  TREAT THE GKS                DRIVER             **
12082C               ******************************************************
12083C
1208411000 CONTINUE
12085CCCCC IGKSCL = 1: CLEAR ALWAYS
12086CCCCC IGKSCL = 0: CLEAR CONDITIONALLY
12087      IGKSCL=1
12088C
12089#ifdef HAVE_GKS
12090      CALL GCLRWK(IGKSWK, IGKSCL)
12091      ITNR=1
12092      XMIN=0.0
12093      XMAX=1.0
12094      YMIN=0.0
12095      YMAX=1.0
12096      CALL GSWN(ITNR,XMIN,XMAX,YMIN,YMAX)
12097      NINDX=1
12098CCCCC CALL GSCR(IGKSWK,NINDX,1.0,1.0,1.0)
12099#endif
12100      GOTO9000
12101C
12102C               ******************************************************
12103C               **  STEP 120--                                      **
12104C               **  TREAT THE GD                     DRIVER         **
12105C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
12106C               **  1) JPEG                                         **
12107C               **  2) PNG                                          **
12108C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
12109C               **  4) GIF                                          **
12110C               **  5) TIFF ?                                       **
12111C               ******************************************************
12112C
12113C     NOTE 3/2008: SPECIFY WHETHER IMAGE WILL BE "TRUE COLOR" OR
12114C                  "FIXED" COLOR.
1211512000 CONTINUE
12116      IXTEMP=INT(ANUMHP)
12117      IYTEMP=INT(ANUMVP)
12118C
12119      IF(IGUNIT.EQ.44)THEN
12120        DO12001I=80,1,-1
12121          ILAST=I
12122          IF(IPL2NA(I:I).NE.' ')GOTO12009
1212312001   CONTINUE
12124        ILAST=1
1212512009   CONTINUE
12126      ELSE
12127        DO12010I=80,1,-1
12128          ILAST=I
12129          IF(IPL1NA(I:I).NE.' ')GOTO12019
1213012010   CONTINUE
12131        ILAST=1
1213212019   CONTINUE
12133      ENDIF
12134C
12135      DO12020I=1,ILAST
12136        CALL DPCOAN(IPL1NA(I:I),IJUNK)
12137        IADE(I)=IJUNK
1213812020 CONTINUE
12139      IADE(ILAST+1)=0
12140      ICOLTY=0
12141      IF(IGDCO.EQ.'TRUE')ICOLTY=1
12142#ifdef HAVE_GD
12143      CALL GDERAS(IXTEMP,IYTEMP,JCOL,ICOLTY,IADE)
12144#endif
12145      GOTO9000
12146C
12147C               ******************************************************
12148C               **  STEP 130--                                      **
12149C               **  TREAT THE ABSOFT                 DRIVER         **
12150C               ******************************************************
12151C
1215213000 CONTINUE
12153      GOTO9000
12154C
12155C               ******************************************************
12156C               **  STEP 135--                                      **
12157C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
12158C               ******************************************************
12159C
1216013500 CONTINUE
12161      NPLOT=1
12162COLD  CALL aqtOpenPlot(NPLOT)
12163COLD  CALL aqtSetPlotSize(ANUMHP,ANUMVP)
12164COLD  CALL aqtSetPlotTitle('Dataplot Graphics Window')
12165#ifdef HAVE_AQUA
12166      CALL aqeras(NPLOT,NUMHPP,NUMVPP,JCOL)
12167#endif
12168      GOTO9000
12169C
12170C               ******************************************************
12171C               **  STEP 150--                                      **
12172C               **  TREAT THE LATEX (USING EEPIC)            DRIVER **
12173C               ******************************************************
1217415000 CONTINUE
12175      IF(ILATOS.EQ.'ON')THEN
12176        ICSTR(1:1)=IBASLC
12177        ICSTR(2:13)='end{picture}'
12178        NCSTR=13
12179        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12180        ICSTR(1:1)=IBASLC
12181        ICSTR(2:8)='newpage'
12182        NCSTR=8
12183        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12184      ENDIF
12185C
12186      ILATOS='ON'
12187C
12188      ICSTR(1:1)=IBASLC
12189      ICSTR(2:31)='setlength{ unitlength}{0.24pt}'
12190      ICSTR(12:12)=IBASLC
12191      NCSTR=31
12192      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12193C
12194      ICSTR(1:1)=IBASLC
12195      ICSTR(2:16)='begin{picture}('
12196      NCSTR=16
12197      NCHTOT=5
12198      CALL GRTRIN(NUMHPP,NCHTOT,ICSTR,NCSTR)
12199      NCSTR=NCSTR+1
12200      ICSTR(NCSTR:NCSTR)=','
12201      NCHTOT=5
12202      CALL GRTRIN(NUMVPP,NCHTOT,ICSTR,NCSTR)
12203      NCSTR=NCSTR+1
12204      ICSTR(NCSTR:NCSTR)=')'
12205      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12206      IF(ILATCO.EQ.'ON' .AND. JCOL.NE.0)THEN
12207        ICSTR(1:1)=IBASLC
12208        ICSTR(2:16)='pagecolor{    }'
12209        ICSTR(13:16)=ICOLT(1:4)
12210        NCSTR=16
12211        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12212      ENDIF
12213C
12214      GOTO9000
12215C
12216C               ******************************************************
12217C               **  STEP 160--                                      **
12218C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
12219C               ******************************************************
12220C
1222116000 CONTINUE
12222C
12223      CALL DPCONA(34,IQUOTE)
12224C
12225      IF(ISVGOS.EQ.'ON')THEN
12226        IF(ISVGCN.GT.0)THEN
12227          ICSTR(1:7)='   </g>'
12228          NCSTR=-7
12229          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12230          ICSTR(1:6)='</svg>'
12231          NCSTR=-6
12232          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12233          ICSTR(1:26)='<!--  END OF SVG GRAPH -->'
12234          NCSTR=-26
12235          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12236          ICSTR(1:1)=' '
12237          NCSTR=-1
12238          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12239        ENDIF
12240      ELSE
12241        ISVGOS='ON'
12242      ENDIF
12243      ISVGCN=ISVGCN+1
12244C
12245      IF(ISVGCN.GT.1)THEN
12246        ICSTR(1:14)='<?xml version='
12247        ICSTR(15:15)=IQUOTE
12248        ICSTR(16:18)='1.0'
12249        ICSTR(19:19)=IQUOTE
12250        ICSTR(20:29)=' encoding='
12251        ICSTR(30:30)=IQUOTE
12252        ICSTR(31:40)='ISO-8859-1'
12253        ICSTR(41:41)=IQUOTE
12254        ICSTR(42:53)=' standalone='
12255        ICSTR(54:54)=IQUOTE
12256        ICSTR(55:56)='no'
12257        ICSTR(57:57)=IQUOTE
12258        ICSTR(58:59)='?>'
12259        NCSTR=-59
12260        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12261        ICSTR(1:21)='<!DOCTYPE svg PUBLIC '
12262        ICSTR(22:22)=IQUOTE
12263        ICSTR(23:50)='-//W3C//DTD SVG 20010904//EN'
12264        ICSTR(51:51)=IQUOTE
12265        NCSTR=-51
12266        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12267        ICSTR(1:5)='     '
12268        ICSTR(6:6)=IQUOTE
12269        ICSTR(7:50)='http://www.w3.org./TR/2001/REC-SVG-20010904/'
12270        ICSTR(51:63)='DTD/svg10.dtd'
12271        ICSTR(64:64)=IQUOTE
12272        ICSTR(65:65)='>'
12273        NCSTR=-65
12274        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12275C
12276        IF(ISVGSS(1:3).EQ.'EXT')THEN
12277          NCSTR=22
12278          ICSTR(1:NCSTR)='<?xml-stylesheet href='
12279          NCSTR=-NCSTR
12280          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12281          NCSTR=1
12282          ICSTR(NCSTR:NCSTR)=IQUOTE
12283          NCTEMP=1
12284          DO16001I=80,1,-1
12285            NCTEMP=I
12286            IF(ISVGSN(I:I).NE.' ')GOTO16003
1228716001     CONTINUE
1228816003     CONTINUE
12289          NCSTR=NCSTR+1
12290          ICSTR(NCSTR:NCSTR+NCTEMP-1)=ISVGSN(1:NCTEMP)
12291          NCSTR=NCSTR+NCTEMP
12292          ICSTR(NCSTR:NCSTR)=IQUOTE
12293          NCSTR=-NCSTR
12294          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12295          NCSTR=22
12296          ICSTR(1:NCSTR)='                 type='
12297          NCSTR=NCSTR+1
12298          ICSTR(NCSTR:NCSTR)=IQUOTE
12299          NCSTR=NCSTR+1
12300          ICSTR(NCSTR:NCSTR+7)='text/css'
12301          NCSTR=NCSTR+8
12302          ICSTR(NCSTR:NCSTR)=IQUOTE
12303          NCSTR=NCSTR+1
12304          ICSTR(NCSTR:NCSTR+1)='?>'
12305          NCSTR=-(NCSTR+1)
12306          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12307        ENDIF
12308C
12309        ICSTR(1:11)='<svg xmlns='
12310        ICSTR(12:12)=IQUOTE
12311        ICSTR(13:38)='http://www.w3.org/2000/svg'
12312        ICSTR(39:39)=IQUOTE
12313        NCSTR=-39
12314        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12315        ICSTR(1:17)='     xmlns:xlink='
12316        ICSTR(18:18)=IQUOTE
12317        ICSTR(19:46)='http://www.w3.org/1999/xlink'
12318        ICSTR(47:47)=IQUOTE
12319        ICSTR(48:58)=' xml:space='
12320        ICSTR(59:59)=IQUOTE
12321        ICSTR(60:67)='preserve'
12322        ICSTR(68:68)=IQUOTE
12323        NCSTR=-68
12324        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12325C
12326        NCHTOT=6
12327        IXTEMP=INT(ANUMHP)
12328        IYTEMP=INT(ANUMVP)
12329C
12330        ICSTR(1:11)='     width='
12331        ICSTR(12:12)=IQUOTE
12332        NCSTR=12
12333        CALL GRTRIN(IXTEMP,NCHTOT,ICSTR,NCSTR)
12334        NCSTR=NCSTR+1
12335        ICSTR(NCSTR:NCSTR)=IQUOTE
12336        NCSTR=NCSTR+1
12337        ICSTR(NCSTR:NCSTR+7)=' height='
12338        NCSTR=NCSTR+8
12339        ICSTR(NCSTR:NCSTR)=IQUOTE
12340        CALL GRTRIN(IYTEMP,NCHTOT,ICSTR,NCSTR)
12341        NCSTR=NCSTR+1
12342        ICSTR(NCSTR:NCSTR)=IQUOTE
12343        NCSTR=-NCSTR
12344        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12345        ICSTR(1:13)='     viewBox='
12346        ICSTR(14:14)=IQUOTE
12347        ICSTR(15:18)='0 0 '
12348        NCSTR=18
12349        CALL GRTRIN(IXTEMP,NCHTOT,ICSTR,NCSTR)
12350        NCSTR=NCSTR+1
12351        ICSTR(NCSTR:NCSTR)=' '
12352        CALL GRTRIN(IYTEMP,NCHTOT,ICSTR,NCSTR)
12353        NCSTR=NCSTR+1
12354        ICSTR(NCSTR:NCSTR)=IQUOTE
12355        NCSTR=NCSTR+1
12356        ICSTR(NCSTR:NCSTR)='>'
12357        NCSTR=-NCSTR
12358        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12359C
12360        ICSTR(1:9)='   <desc>'
12361        NCSTR=-9
12362        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12363        ICSTR(1:47)='   SVG GRAPHIC CREATED BY DATAPLOT: SEPTEMBER, '
12364        ICSTR(48:60)='2010 VERSION.'
12365        NCSTR=-60
12366        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12367        ICSTR(1:10)='   </desc>'
12368        NCSTR=-10
12369        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12370C
12371        ICSTR(1:9)='   <g id='
12372        ICSTR(10:10)=IQUOTE
12373        ICSTR(11:15)='graph'
12374        NCSTR=15
12375        NCHTOT=1
12376        IF(ISVGCN.GT.9)NCHTOT=2
12377        IF(ISVGCN.GT.99)NCHTOT=3
12378        IF(ISVGCN.GT.999)NCHTOT=4
12379        IF(ISVGCN.GT.9999)NCHTOT=5
12380        CALL GRTRIN(ISVGCN,NCHTOT,ICSTR,NCSTR)
12381        NCSTR=NCSTR+1
12382        ICSTR(NCSTR:NCSTR)=IQUOTE
12383        NCSTR=NCSTR+1
12384        ICSTR(NCSTR:NCSTR)='>'
12385        NCSTR=-NCSTR
12386        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12387C
12388C       CREATE BACKGROUND VIA FILLED RECTANGLE
12389C
12390        ICSTR(1:11)='   <rect x='
12391        NCSTR=-11
12392        ICSTR(12:12)=IQUOTE
12393        ICSTR(13:13)='0'
12394        ICSTR(14:14)=IQUOTE
12395        ICSTR(15:17)=' y='
12396        ICSTR(18:18)=IQUOTE
12397        ICSTR(19:19)='0'
12398        ICSTR(20:20)=IQUOTE
12399        NCSTR=-20
12400        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12401C
12402        ICSTR(1:15)='         width='
12403        ICSTR(16:16)=IQUOTE
12404        ICSTR(17:20)='100%'
12405        ICSTR(21:21)=IQUOTE
12406        ICSTR(22:29)=' height='
12407        ICSTR(30:30)=IQUOTE
12408        ICSTR(31:34)='100%'
12409        ICSTR(35:35)=IQUOTE
12410        NCSTR=-35
12411        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12412C
12413        IF(ISVGSS(1:3).EQ.'EXT')THEN
12414          ICSTR(1:17)='           class='
12415          ICSTR(18:18)=IQUOTE
12416          ICSTR(19:28)='background'
12417          ICSTR(29:29)=IQUOTE
12418          NCSTR=-29
12419          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12420        ELSE
12421          ICSTR(1:15)='         style='
12422          ICSTR(16:16)=IQUOTE
12423          ICSTR(17:29)='stroke:none; '
12424          ICSTR(30:35)='fill:#'
12425          NCSTR=35
12426          NCHTOT=2
12427          JTEMP=JCOL
12428          IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JTEMP=1
12429          JRED=IRED(JTEMP)
12430          CALL DPCONX(JRED,ICJUNK)
12431          NCSTR=NCSTR+1
12432          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
12433          NCSTR=NCSTR+1
12434          JGREEN=IGREEN(JTEMP)
12435          CALL DPCONX(JGREEN,ICJUNK)
12436          NCSTR=NCSTR+1
12437          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
12438          NCSTR=NCSTR+1
12439          JBLUE=IBLUE(JTEMP)
12440          CALL DPCONX(JBLUE,ICJUNK)
12441          NCSTR=NCSTR+1
12442          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
12443          NCSTR=NCSTR+2
12444          ICSTR(NCSTR:NCSTR)=';'
12445          NCSTR=NCSTR+1
12446          ICSTR(NCSTR:NCSTR)=IQUOTE
12447          ICSTR(NCSTR+1:NCSTR+2)='/>'
12448          NCSTR=NCSTR+2
12449          NCSTR=-NCSTR
12450          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12451        ENDIF
12452      ENDIF
12453      GOTO9000
12454C
12455C               ******************************************************
12456C               **  STEP 170--                                      **
12457C               **  TREAT THE CAIRO                          DRIVER **
12458C               ******************************************************
12459C
12460C     DO A SHOW PAGE TO GENERATE THE CURRENT PLOT.
12461C
12462C     NOTE: SINCE GRINDE ESSENTIALLY STARTS A NEW PAGE, DO NOT GENERATE
12463C           A PAGE ERASE FOR THE FIRST PLOT (USER CAN ENTER AN ERASE
12464C           COMMAND IF THIS IS DESIRED).
12465C
1246617000 CONTINUE
12467C
12468#ifdef HAVE_CAIRO
12469      CALL CACHEC(IEXPOSE,IERRNO)
12470      IF(IERRNO.NE.0)THEN
12471        WRITE(ICOUT,17621)
1247217621   FORMAT(1X,'WARNING: X11 GRAPHICS WINDOW HAS BEEN DESTROYED.')
12473        CALL DPWRST('XXX','BUG ')
12474        GOTO9000
12475      ENDIF
12476C
12477      IVAL1=0
12478      IF(IMODEL.EQ.'X11')IVAL1=1
12479      IF(IMODEL.EQ.'POST')IVAL1=2
12480      IF(IMODEL.EQ.'PDF')IVAL1=3
12481      IF(IMODEL.EQ.'SVG')IVAL1=4
12482      IF(IMODEL.EQ.'QUAR')IVAL1=5
12483      IF(IMODEL.EQ.'PNG')IVAL1=6
12484      IF(IMODEL.EQ.'WIND')IVAL1=7
12485      IF(IMODEL.EQ.'EPS')IVAL1=8
12486      IVAL2=1
12487      IF(IGUNIT.EQ.IPL1NU)THEN
12488        IVAL2=2
12489        IPSTPN=IPSTPN+1
12490      ELSEIF(IGUNIT.EQ.IPL2NU)THEN
12491        IVAL2=3
12492        IPSTP2=IPSTP2+1
12493      ENDIF
12494      ATEMP=255.0
12495      ARED=REAL(IRED(JCOL))/ATEMP
12496      AGREEN=REAL(IGREEN(JCOL))/ATEMP
12497      ABLUE=REAL(IBLUE(JCOL))/ATEMP
12498      IXRET=INT(ANUMHP+0.5)
12499      IYRET=INT(ANUMVP+0.5)
12500C
12501      IF(IVAL2.EQ.1)THEN
12502        CALL CAREND(IVAL2,IVAL1)
12503        CALL CAERAS(IVAL2,IVAL1,ANUMHP,ANUMVP,ARED,AGREEN,ABLUE,
12504     1              IXRET,IYRET)
12505      ELSE
12506        IF(IVAL2.EQ.2 .AND. IPSTPN.EQ.1)GOTO9000
12507        IF(IVAL2.EQ.3 .AND. IPSTP2.EQ.1)GOTO9000
12508        CALL CAREND(IVAL2,IVAL1)
12509        CALL CACHEC(IEXPOSE,IERRNO)
12510        CALL CAERAS(IVAL2,IVAL1,ANUMHP,ANUMVP,ARED,AGREEN,ABLUE,
12511     1              IXRET,IYRET)
12512      ENDIF
12513C
12514C     RESET SIZE OF WINDOW IF NEEDED
12515C
12516      IF(IVAL1.EQ.1 .AND. IVAL2.EQ.1)THEN
12517        ANUMHP=REAL(IXRET)
12518        ANUMVP=REAL(IYRET)
12519        NUMHPP=INT(ANUMHP+0.1)
12520        NUMVPP=INT(ANUMVP+0.1)
12521      ENDIF
12522C
12523      CALL CACHEC(IEXPOSE,IERRNO)
12524      IF(IERRNO.NE.0)THEN
12525        WRITE(ICOUT,17621)
12526        CALL DPWRST('XXX','BUG ')
12527      ENDIF
12528#endif
12529      GOTO9000
12530C
12531C               ******************************************************
12532C               **  STEP 180--                                      **
12533C               **  TREAT THE WMF                            DRIVER **
12534C               ******************************************************
12535C
1253618000 CONTINUE
12537      GOTO9000
12538C
12539C               ******************************************************
12540C               **  STEP 190--                                      **
12541C               **  TREAT THE D3                             DRIVER **
12542C               ******************************************************
12543C
1254419000 CONTINUE
12545      GOTO9000
12546C
12547C               *****************
12548C               **  STEP 90--  **
12549C               **  EXIT       **
12550C               *****************
12551C
12552 9000 CONTINUE
12553      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'ERSC')THEN
12554        WRITE(ICOUT,999)
12555        CALL DPWRST('XXX','BUG ')
12556        WRITE(ICOUT,9011)
12557 9011   FORMAT('***** AT THE END       OF GRERSC--')
12558        CALL DPWRST('XXX','BUG ')
12559        WRITE(ICOUT,9014)JCOL,IGBAUD,AGERDE,ICHAPS,INULLI
12560 9014   FORMAT('JCOL,IGBAUD,AGERDE,ICHAPS,INULLI = ',2I8,G15.7,2I8)
12561        CALL DPWRST('XXX','BUG ')
12562        WRITE(ICOUT,9015)IESCC,IFFC,ISYNC,IERRG4
12563 9015   FORMAT('IESCC,IFFC,ISYNC,IERRG4 = ',3(A1,2X),A4)
12564        CALL DPWRST('XXX','BUG ')
12565        IF(NCSTR.GT.0)THEN
12566          DO9025I=1,NCSTR
12567            CALL DPCOAN(ICSTR(I:I),IASCNE)
12568            WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
12569 9026       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
12570            CALL DPWRST('XXX','BUG ')
12571 9025     CONTINUE
12572        ENDIF
12573      ENDIF
12574C
12575      RETURN
12576      END
12577      SUBROUTINE GREXIT
12578C
12579C     PURPOSE--SHUT DOWN A DEVICE BEFORE EXITING DATAPLOT TO DEFAULT
12580C              POWER-ON CONDITIONS.  PERFORMS FUNCTION ANALOGOUS TO
12581C              GRINDE (GRINDE DONE WHEN DEVICE FIRST TURNED ON, GREXIT
12582C              WHEN EXIT DATAPLOT).  THIS ROUTINE REQUIRED BY MANY LASER
12583C              PRINTERS TO FORCE A PAGE ERASE BEFORE EXITING.
12584C
12585C     WRITTEN BY--ALAN HECKERT
12586C                 STATISTICAL ENGINEERING DIVISION
12587C                 INFORMATION TECHNOLOGY LABORATORY
12588C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
12589C                 GAITHERSBURG, MD 20899-8980
12590C                 PHONE--301-975-2899
12591C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
12592C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
12593C     LANGUAGE--ANSI FORTRAN (1977)
12594C     VERSION NUMBER--89.2
12595C     ORIGINAL VERSION--JANUARY   1989.
12596C     UPDATED         --MARCH     1990.  X11 DEVICE ADDED (BY ALAN HECKERT)
12597C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
12598C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
12599C                                      DRIVER OBSOLETE
12600C     UPDATED         --AUGUST   1992. UPDATE FOR HP-GL (LASER JET III)
12601C     UPDATED         --JANUARY  1993. POSTSCRIPT "%%" LINES (ALAN)
12602C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
12603C                                      OLD CALCOMP STYLE, OBSOLETE
12604C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
12605C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
12606C                                      USE BILL MITCHELLS OPENGL
12607C                                      BINDING FOR FORTRAN
12608C     UPDATED         --OCTOBER  1996. GKS (ALAN)
12609C                                      CODED, NOT TESTED
12610C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
12611C                                      PLACEHOLDER FOR NOW
12612C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
12613C                                      PLACEHOLDER FOR NOW
12614C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
12615C                                      PLACEHOLDER FOR NOW
12616C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
12617C                                      PLACEHOLDER FOR NOW
12618C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
12619C     UPDATED         --JUNE     2000. MACINTOSH
12620C                                      PLACEHOLDER FOR NOW
12621C     UPDATED         --JUNE     2000. PC PRINTER
12622C                                      PLACEHOLDER FOR NOW
12623C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
12624C                                      PLACEHOLDER FOR NOW
12625C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
12626C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
12627C     UPDATED         --FEBRUARY 2006. IMPLEMENT LATEX DRIVER
12628C     UPDATED         --APRIL    2009. IMPLEMENT UNIX LIBPLOT LIBRARY
12629C     UPDATED         --APRIL    2009. REMOVE "XXXX",RAMTEK, PCL, PRIN
12630C     UPDATED         --NOVEMBER 2015. IDEVO3 OPTION
12631C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
12632C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
12633C                                      DEVICE DRIVERS (CAIRO, WMF, D3)
12634C
12635C-----NON-COMMON VARIABLES (GRAPHICS)-----------------------------------
12636C
12637#ifdef HAVE_WININTERACTER
12638      USE WINTERACTER
12639#endif
12640#ifdef HAVE_INTERACTER
12641      USE INTERACTER
12642#endif
12643      CHARACTER*130 ICSTR
12644      CHARACTER*130 IATEMP
12645      CHARACTER*4 IERROR
12646      CHARACTER*4 ISUBN0
12647      CHARACTER*4 ISUBRO
12648      CHARACTER*1 ICARAT
12649      INTEGER IADE(81)
12650C
12651C-----COMMON----------------------------------------------------------
12652C
12653      INCLUDE 'DPCOPA.INC'
12654      INCLUDE 'DPCOGR.INC'
12655      INCLUDE 'DPCONP.INC'
12656      INCLUDE 'DPCOBE.INC'
12657      INCLUDE 'DPCODV.INC'
12658      INCLUDE 'DPCOST.INC'
12659      INCLUDE 'DPCOF2.INC'
12660C
12661      COMMON/QUICKW5/IQWNFL
12662C
12663CCCCC CHARACTER*80 IFILE1
12664      CHARACTER (LEN=MAXFNC) :: IFILE1
12665      CHARACTER*12 ISTAT1
12666      CHARACTER*12 IFORM1
12667      CHARACTER*12 IACCE1
12668      CHARACTER*12 IPROT1
12669      CHARACTER*12 ICURS1
12670      CHARACTER*4 IENDF1
12671      CHARACTER*4 IREWI1
12672      CHARACTER*4 IERRF1
12673C
12674      INTEGER IGKSID
12675      INTEGER IGKSWK
12676      INTEGER IGKSTY
12677      COMMON/IGKS/IGKSID,IGKSWK,IGKSTY
12678C
12679C-----COMMON VARIABLES (GENERAL)--------------------------------------
12680C
12681      INCLUDE 'DPCOP2.INC'
12682C
12683C-----START POINT-----------------------------------------------------
12684C
12685      ISUBN0='EXIT'
12686      IERRG4='NO'
12687C
12688      NCSTR=(-999)
12689C
12690      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'EXIT')THEN
12691        WRITE(ICOUT,999)
12692  999   FORMAT(1X)
12693        CALL DPWRST('XXX','BUG ')
12694        WRITE(ICOUT,51)
12695   51   FORMAT('***** AT THE BEGINNING OF GREXIT--')
12696        CALL DPWRST('XXX','BUG ')
12697        WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3
12698   52   FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',3(A4,2X),A4)
12699        CALL DPWRST('XXX','BUG ')
12700        WRITE(ICOUT,54)IGCODE,ISOFT,ISOFT2,ISOFT3
12701   54   FORMAT('IGCODE,ISOFT,ISOFT2,ISOFT3 = ',3(A4,2X),A4)
12702        CALL DPWRST('XXX','BUG ')
12703        WRITE(ICOUT,55)IGUNIT,IGBAUD
12704   55   FORMAT('IGUNIT,IGBAUD = ',2I8)
12705        CALL DPWRST('XXX','BUG ')
12706        WRITE(ICOUT,56)IBUGG4,ISUBG4,IERRG4
12707   56   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
12708        CALL DPWRST('XXX','BUG ')
12709      ENDIF
12710C
12711C               ********************************************
12712C               **  STEP 1--                              **
12713C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
12714C               **  AND THE MODEL                         **
12715C               ********************************************
12716C
12717      IF(IMANUF.EQ.'QWIN')THEN
12718        GOTO4700
12719      ELSEIF(IMANUF.EQ.'POST')THEN
12720        GOTO8600
12721      ELSEIF(IMANUF.EQ.'X11 ')THEN
12722        GOTO9600
12723      ELSEIF(IMANUF.EQ.'AQUA')THEN
12724        GOTO13500
12725      ELSEIF(IMANUF.EQ.'GENE')THEN
12726        IF(IMODEL.EQ.'CODE')GOTO3200
12727        IF(IMODEL.EQ.'CGM')GOTO3300
12728        IF(IMODEL.EQ.'CGMB')GOTO3400
12729        GOTO3100
12730      ELSEIF(IMANUF.EQ.'SVG ')THEN
12731        GOTO16000
12732      ELSEIF(IMANUF.EQ.'GD  ')THEN
12733        GOTO12000
12734      ELSEIF(IMANUF.EQ.'LATE')THEN
12735        GOTO15000
12736      ELSEIF(IMANUF.EQ.'CAIR')THEN
12737        GOTO17000
12738      ELSEIF(IMANUF.EQ.'D3  ')THEN
12739        GOTO19000
12740      ELSEIF(IMANUF.EQ.'WMF ')THEN
12741        GOTO18000
12742      ELSEIF(IMANUF.EQ.'OPGL')THEN
12743        GOTO4800
12744      ELSEIF(IMANUF.EQ.'TEKT')THEN
12745        GOTO1100
12746      ELSEIF(IMANUF.EQ.'HP')THEN
12747        IF(IMODEL.EQ.'7221')GOTO2100
12748        IF(IMODEL.EQ.'2622')GOTO2300
12749        IF(IMODEL.EQ.'2623')GOTO2300
12750        IF(IMODEL.EQ.'2627')GOTO2300
12751        IF(IMODEL.EQ.'2647')GOTO2300
12752        GOTO2200
12753      ELSEIF(IMANUF.EQ.'LIBP')THEN
12754        GOTO2600
12755      ELSEIF(IMANUF.EQ.'REGI')THEN
12756        GOTO8100
12757      ELSEIF(IMANUF.EQ.'GKS ')THEN
12758        GOTO11000
12759      ELSEIF(IMANUF.EQ.'LAHE')THEN
12760        IF(IMODEL.EQ.'INTE')GOTO4900
12761        IF(IMODEL.EQ.'WINT')GOTO4950
12762        GOTO4600
12763      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
12764        GOTO13000
12765      ELSEIF(IMANUF.EQ.'QUIC')THEN
12766        GOTO9100
12767      ELSEIF(IMANUF.EQ.'CALC')THEN
12768        GOTO4100
12769      ELSEIF(IMANUF.EQ.'ZETA')THEN
12770        GOTO5100
12771      ELSEIF(IMANUF.EQ.'TURB')THEN
12772        GOTO10000
12773      ELSEIF(IMANUF.EQ.'SUN ')THEN
12774        GOTO6600
12775      ENDIF
12776      GOTO9000
12777C
12778C               ***************************************************
12779C               **  STEP 11--                                    **
12780C               **  TREAT THE TEKTRONIX 4027 CASE--              **
12781C               **  (A COLOR TERMINAL).                          **
12782C               ***************************************************
12783C
12784 1100 CONTINUE
12785      GOTO9000
12786C
12787C               ****************************************************
12788C               **  STEP 21--                                     **
12789C               **  TREAT THE HEWLETT-PACKARD 7221 CASE           **
12790C               **  (MULTI-COLOR PENPLOTTER)                      **
12791C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER          **
12792C               **             OPERATING AND PROGRAMMING MANUAL,  **
12793C               **             PAGE XX.                           **
12794C               ****************************************************
12795C
12796 2100 CONTINUE
12797      GOTO9000
12798C
12799C               ******************************************************
12800C               **  STEP 22--                                       **
12801C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
12802C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
12803C               ******************************************************
12804C
12805C  AUGUST 1992.  UPDATE FOR LASER JET III.
12806C
12807 2200 CONTINUE
12808      ICSTR(1:3)='SP;'
12809      NCSTR=3
12810      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12811      IF(IMODE3.NE.'LJET')GOTO9000
12812      ICSTR(1:1)=IESCC
12813      ICSTR(2:2)='E'
12814      NCSTR=2
12815      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12816      GOTO9000
12817C
12818C               **********************************************************
12819C               **  STEP 23--                                           **
12820C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
12821C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
12822C               **  (MONOCHROME DISPLAY TERMINALS)                      **
12823C               **********************************************************
12824C
12825 2300 CONTINUE
12826      GOTO9000
12827C
12828C               **********************************************************
12829C               **  STEP 26--                                           **
12830C               **  UNIX LIBPLOT LIBRARY                                **
12831C               **********************************************************
12832C
12833 2600 CONTINUE
12834      IERR=0
12835#ifdef HAVE_LIBPLOT
12836      CALL PLEND(IERR)
12837#endif
12838      IF(IERR.EQ.1)THEN
12839        WRITE(ICOUT,2601)
12840 2601   FORMAT('***** ERROR FROM LIBPLOT DEVICE--')
12841        CALL DPWRST('XXX','BUG ')
12842        WRITE(ICOUT,2603)
12843 2603   FORMAT('      ERROR OCCURED IN CALL TO  pl_closepl  ROUTINE.')
12844        CALL DPWRST('XXX','BUG ')
12845      ELSEIF(IERR.EQ.2)THEN
12846        WRITE(ICOUT,2601)
12847        CALL DPWRST('XXX','BUG ')
12848        WRITE(ICOUT,2613)
12849 2613   FORMAT('      ERROR OCCURED IN CALL TO  pl_deletepl  ROUTINE.')
12850        CALL DPWRST('XXX','BUG ')
12851      ENDIF
12852      GOTO9000
12853C
12854C               ***************************************************
12855C               **  STEP 31--                                    **
12856C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE  **
12857C               ***************************************************
12858C
12859 3100 CONTINUE
12860      GOTO9000
12861C
12862C               ***************************************************************
12863C               **  STEP 32--                                                **
12864C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
12865C               ***************************************************************
12866C
12867 3200 CONTINUE
12868      GOTO9000
12869C
12870C               ***************************************************
12871C               **  STEP 33--                                    **
12872C               **  TREAT THE CGM     (DEVICE-INDEPENDENT) CASE  **
12873C               **  1) CHECK IF A "PICTURE" IS CURRENTLY ACTIVE  **
12874C               **  2) END OF METAFILE                           **
12875C               ***************************************************
12876C
12877 3300 CONTINUE
12878      IF(ICGMSW.EQ.'ON')THEN
12879        ICSTR(1:7)='ENDPIC;'
12880        NCSTR=7
12881        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12882      ENDIF
12883      ICSTR(1:6)='ENDMF;'
12884      NCSTR=6
12885      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
12886      GOTO9000
12887C
12888C               ***************************************************
12889C               **  STEP 34--                                    **
12890C               **  TREAT THE CGM (BINARY)                 CASE  **
12891C               **  1) CHECK IF A "PICTURE" IS CURRENTLY ACTIVE  **
12892C               **  2) END OF METAFILE                           **
12893C               ***************************************************
12894C
12895 3400 CONTINUE
12896      GOTO9000
12897C
12898C               ******************************************************
12899C               **  STEP 41--                                       **
12900C               **  TREAT THE CALCOMP XXXXXX CASE                   **
12901C               **  USE CALCOMP LIBRARY ROUTINE                     **
12902C               **  REFERENCE--XX                                   **
12903C               **             XX                                   **
12904C               **             PAGES XX AND XX                      **
12905C               ******************************************************
12906C
12907 4100 CONTINUE
12908      IPEN=999
12909      XNEW=0.
12910      YNEW=0.
12911#ifdef HAVE_CALCOMP
12912      CALL PLOT(XNEW,YNEW,IPEN)
12913#endif
12914      GOTO9000
12915C
12916C               ******************************************************
12917C               **  STEP 46--                                       **
12918C               **  TREAT THE LAHEY   XXXXXX CASE                   **
12919C               **  REFERENCE--Programmer's Reference, Revision C   **
12920C               **             Lahey Computer Systems, January, 1992**
12921C               **             PAGES 51 THRU 65                     **
12922C               ******************************************************
12923C
12924 4600 CONTINUE
12925C
12926C  ILAHSW  = ON IF GRAPHICS MODE SET, OFF IF NORMAL VIDEO MODE SET
12927C
12928CCCCC IF(ILAHSW.EQ.'ON')THEN
12929        IPEN=999
12930        XNEW=0.
12931        YNEW=0.
12932#ifdef HAVE_LAHEY_CALCOMP
12933        CALL PLOT(XNEW,YNEW,IPEN)
12934#endif
12935CCCCC ENDIF
12936      GOTO9000
12937C
12938C               ******************************************************
12939C               **  STEP 47--                                       **
12940C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
12941C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
12942C               ******************************************************
12943C
12944 4700 CONTINUE
12945      GOTO9000
12946C
12947C               ******************************************************
12948C               **  STEP 48--                                       **
12949C               **  TREAT THE OPEN-GL DRIVER                        **
12950C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
12951C               ******************************************************
12952C
12953 4800 CONTINUE
12954#ifdef HAVE_OPEN_GL
12955      CALL GLEND()
12956#endif
12957      GOTO9000
12958C
12959C               ******************************************************
12960C               **  STEP 49--                                       **
12961C               **  TREAT THE LAHEY INTERACTOR CASE                 **
12962C               ******************************************************
12963C
12964 4900 CONTINUE
12965#ifdef HAVE_INTERACTER
12966      CALL IScreenQuit('C')
12967#endif
12968      GOTO9000
12969C
12970C               ******************************************************
12971C               **  STEP 49B-                                       **
12972C               **  TREAT THE LAHEY WINTERACTOR CASE                **
12973C               ******************************************************
12974C
12975 4950 CONTINUE
12976      IHAND2=1
12977#ifdef HAVE_WINTERACTER
12978CCCCC CALL WindowCloseChild(IHAND2)
12979      CALL WindowClose()
12980#endif
12981      GOTO9000
12982C
12983C
12984C               ******************************************************
12985C               **  STEP 51--                                       **
12986C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
12987C               **  TO INITIALIZE DEVICE--                          **
12988C               **  USE THE 70 OP CODE (= RESET)                    **
12989C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
12990C               **             MODELS 3600SX AND 3653SX             **
12991C               **             PAGES B-0 , B-1, AND E-1             **
12992C               ******************************************************
12993C
12994 5100 CONTINUE
12995      IPEN=999
12996      XNEW=0.
12997      YNEW=0.
12998#ifdef HAVE_ZETA
12999      CALL PLOT(XNEW,YNEW,IPEN)
13000#endif
13001      GOTO9000
13002C
13003C               ******************************************************
13004C               **  STEP 66--                                       **
13005C               **  TREAT THE SUN CASE                              **
13006C               **  WRITTEN BY BILL ANDERSON                        **
13007C               ******************************************************
13008C
13009 6600 CONTINUE
13010#ifdef HAVE_SUN
13011      CALL cfclosevws(IVSNAM)
13012      CALL cfclosecgi()
13013#endif
13014      GOTO9000
13015C
13016C               ******************************************************
13017C               **  STEP 81--                                       **
13018C               **  TREAT THE DEC  REGIS CASE                       **
13019C               **  TO INITIALIZE DEVICE---                         **
13020C               **  WRITE OUT AN   XX                               **
13021C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
13022C               **             PAGES XX AND XX                      **
13023C               ******************************************************
13024C
13025 8100 CONTINUE
13026      GOTO9000
13027C
13028C               ******************************************************
13029C               **  STEP 85.1--                                     **
13030C               **  TREAT THE POSTSCRIPT  CASE                      **
13031C               **  1) PRINT THE CURRENT PAGE                       **
13032C               **  2) RESTORE PAGE DEFAULTS                        **
13033C               **  REFERENCE--POSTSCRIPT LANGUAGE TUTORIAL AND     **
13034C               **             COOKBOOK, ADOBE SYSTEMS              **
13035C               **  MODIFIED JANUARY, 1990 TO MAKE "CONFORMING" STYLE*
13036C               ******************************************************
13037C
13038 8600 CONTINUE
13039      ICSTR(1:8)='showpage'
13040      NCSTR=8
13041      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13042C  JANUARY, 1990.  FOLLOWING 4 LINES ADDED FOR ENCAPSULATED POSTSCRIPT
13043      IF(IMODEL.EQ.'ENCA')THEN
13044        ICSTR(1:3)='end'
13045        NCSTR=3
13046        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13047      ENDIF
13048      ICSTR(1:8)='grestore'
13049      NCSTR=8
13050      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13051C  JANUARY, 1990.  FOLLOWING LINES ADDED.
13052      ICSTR(1:9)='%%Trailer'
13053      NCSTR=9
13054      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
13055      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13056      IF(IMODEL.NE.'ENCA')THEN
13057        ICSTR(1:9)='%%Pages: '
13058        NCHTOT=5
13059        NCSTR=9
13060CCCCC   JANUARY 1993.  HANDLE DEVICE 2 AND DEVICE 3 SEPARATELY.
13061        IVALT=IPSTPN
13062CCCCC   IF(IMODE3.EQ.'DEV3')IVALT=IPSTP2
13063        IF(IGUNIT.EQ.IPL2NU)IVALT=IPSTP2
13064        NTEMP=IVALT
13065        IF(IMODE3.EQ.'DEV3' .AND. IDEVO3.EQ.'AUTO')NTEMP=1
13066        CALL GRTRIN(NTEMP,NCHTOT,ICSTR,NCSTR)
13067        IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
13068        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13069      ENDIF
13070      ICSTR(1:33)='% END OF DATAPLOT POSTSCRIPT FILE'
13071      NCSTR=33
13072      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13073      GOTO9000
13074C
13075C               ******************************************************
13076C               **  STEP 90--                                       **
13077C               **  TREAT THE QUIC       CASE                       **
13078C               **  1) PRINT CURRENT PAGE - "^,"                    **
13079C               **  2) RESET DEFAULTS - "^ISYNTAX00000"             **
13080C               **  3) TURN QUIC OFF  - "^-^PN-"                    **
13081C               **  REFERENCE--QUIC PROGRAMMING MANUAL              **
13082C               ******************************************************
13083C
13084 9100 CONTINUE
13085      CALL DPCONA(94,ICARAT)
13086      ICSTR(1:1)=ICARAT
13087      ICSTR(2:2)=','
13088      ICSTR(3:3)=ICARAT
13089      ICSTR(4:15)='ISYNTAX00000'
13090      NCSTR=15
13091      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13092      ICSTR(1:1)=ICARAT
13093      ICSTR(2:2)='-'
13094      ICSTR(3:3)=ICARAT
13095      ICSTR(4:5)='PN'
13096      ICSTR(6:6)=ICARAT
13097      ICSTR(7:7)='-'
13098      NCSTR=7
13099      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13100      GOTO9000
13101C
13102C               ******************************************************
13103C               **  STEP 95--                                       **
13104C               **  TREAT THE X11        CASE                       **
13105C               ******************************************************
13106C
13107 9600 CONTINUE
13108#ifdef HAVE_X11
13109      IF(IX11OF.NE.'OFF')CALL XEND
13110#endif
13111      GOTO9000
13112C
13113C               *************************************************
13114C               **  STEP 100--                                 **
13115C               **  TREAT THE VGA VIA TURBO-C       CASE       **
13116C               *************************************************
13117C
1311810000 CONTINUE
13119      GOTO9000
13120C
13121C               ******************************************************
13122C               **  STEP 110--                                      **
13123C               **  TREAT THE GKS                DRIVER             **
13124C               ******************************************************
13125C
1312611000 CONTINUE
13127#ifdef HAVE_GKS
13128      CALL GDAWK(IGKSWK)
13129      CALL GCLWK(IGKSWK)
13130      CALL GCLKS
13131#endif
13132      GOTO9000
13133C
13134C               ******************************************************
13135C               **  STEP 120--                                      **
13136C               **  TREAT THE GD                     DRIVER         **
13137C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
13138C               **  1) JPEG                                         **
13139C               **  2) PNG                                          **
13140C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
13141C               ******************************************************
13142C
1314312000 CONTINUE
13144C
13145      IF(IGUNIT.EQ.44)THEN
13146        DO12001I=80,1,-1
13147          ILAST=I
13148          IF(IPL2NA(I:I).NE.' ')GOTO12009
1314912001   CONTINUE
13150        ILAST=1
1315112009   CONTINUE
13152      ELSE
13153        DO12010I=80,1,-1
13154          ILAST=I
13155          IF(IPL1NA(I:I).NE.' ')GOTO12019
1315612010   CONTINUE
13157        ILAST=1
1315812019   CONTINUE
13159      ENDIF
13160C
13161      DO12020I=1,ILAST
13162        CALL DPCOAN(IPL1NA(I:I),IJUNK)
13163        IADE(I)=IJUNK
1316412020 CONTINUE
13165      IADE(ILAST+1)=0
13166#ifdef HAVE_GD
13167      CALL GDEND(IADE)
13168#endif
13169      GOTO9000
13170C
13171C               ******************************************************
13172C               **  STEP 130--                                      **
13173C               **  TREAT THE ABSOFT                 DRIVER         **
13174C               ******************************************************
13175C
1317613000 CONTINUE
13177      GOTO9000
13178C
13179C               ******************************************************
13180C               **  STEP 135--                                      **
13181C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
13182C               ******************************************************
13183C
1318413500 CONTINUE
13185COLD  CALL aqtClosePlot()
13186#ifdef HAVE_AQUA
13187      CALL aqend()
13188#endif
13189      GOTO9000
13190C
13191C               ******************************************************
13192C               **  STEP 150--                                      **
13193C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
13194C               ******************************************************
13195C
1319615000 CONTINUE
13197C
13198      ICSTR(1:1)=IBASLC
13199      ICSTR(2:13)='end{picture}'
13200      NCSTR=13
13201      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13202C
13203      IF(IMODEL.NE.'STAN')THEN
13204C
13205        ICSTR(1:1)=' '
13206        NCSTR=1
13207        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13208C
13209        ICSTR(1:1)=IBASLC
13210        ICSTR(2:18)='begin{verbatim}'
13211        NCSTR=18
13212        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13213C
13214      ELSEIF(ILATFO.EQ.'NULL')THEN
13215C
13216        ICSTR(1:1)=' '
13217        NCSTR=1
13218        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13219C
13220        ICSTR(1:1)=IBASLC
13221        ICSTR(2:16)='end{document}'
13222        NCSTR=16
13223        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13224C
13225      ELSE
13226        IOUNI1=IST1NU
13227        IFILE1=ILATFO
13228        ISTAT1='OLD'
13229        IFORM1='FORMATTED'
13230        IACCE1='SEQUENTIAL'
13231        IPROT1='READONLY'
13232        ICURS1='CLOSED'
13233        ISUBN0='CAPT'
13234        IERRF1='NO'
13235C
13236        IREWI1='ON'
13237        CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
13238     1                IREWI1,ISUBN0,IERRF1,IBUGG4,ISUBRO,IERROR)
13239        IF(IERRF1.EQ.'YES')GOTO9000
13240C
13241C  NOW LOOP THROUGH FILE (ASSUME MAXIMUM OF 1,000 LINES).
13242C
13243        DO15301I=1,1000
13244          IATEMP=' '
13245          READ(IOUNI1,15392,END=15399,ERR=15399)IATEMP
1324615392     FORMAT(A240)
13247          ILAST=1
13248          DO15410J=240,1,-1
13249            IF(IATEMP(J:J).NE.' ')THEN
13250              ILAST=J
13251              GOTO15419
13252            ENDIF
1325315410     CONTINUE
1325415419     CONTINUE
13255          ICSTR(1:ILAST)=IATEMP(1:ILAST)
13256          NCSTR=ILAST
13257          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
1325815301   CONTINUE
1325915399   CONTINUE
13260        IENDF1='OFF'
13261        IREWI1='ON'
13262        ISUBRO='    '
13263        CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
13264     1                IENDF1,IREWI1,ISUBN0,IERRF1,IBUGG4,ISUBRO,IERROR)
13265        IF(IERRF1.EQ.'YES')GOTO9000
13266      ENDIF
13267      ILATOS='OFF'
13268      GOTO9000
13269C
13270C               ******************************************************
13271C               **  STEP 160--                                      **
13272C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
13273C               ******************************************************
13274C
1327516000 CONTINUE
13276      IF(ISVGOS.EQ.'ON')THEN
13277        ICSTR(1:7)='   </g>'
13278        NCSTR=-7
13279        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13280        ICSTR(1:6)='</svg>'
13281        NCSTR=-6
13282        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13283        ICSTR(1:26)='<!--  END OF SVG GRAPH -->'
13284        NCSTR=-26
13285        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13286        ICSTR(1:1)=' '
13287        NCSTR=-1
13288        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13289        ISVGOS='OFF'
13290        ISVGCN=0
13291      ENDIF
13292      GOTO9000
13293C
13294C               ******************************************************
13295C               **  STEP 170--                                      **
13296C               **  TREAT THE CAIRO                          DRIVER **
13297C               ******************************************************
13298C
1329917000 CONTINUE
13300      IVAL1=0
13301      IF(IMODEL.EQ.'X11')IVAL1=1
13302      IF(IMODEL.EQ.'POST')IVAL1=2
13303      IF(IMODEL.EQ.'PDF')IVAL1=3
13304      IF(IMODEL.EQ.'SVG')IVAL1=4
13305      IF(IMODEL.EQ.'QUAR')IVAL1=5
13306      IF(IMODEL.EQ.'PNG')IVAL1=6
13307      IF(IMODEL.EQ.'WIND')IVAL1=7
13308      IF(IMODEL.EQ.'EPS')IVAL1=8
13309      IVAL2=1
13310      IF(IGUNIT.EQ.IPL1NU)IVAL2=2
13311      IF(IGUNIT.EQ.IPL2NU)IVAL2=3
13312#ifdef HAVE_CAIRO
13313      CALL CAREND(IVAL2,IVAL1)
13314      CALL CAEND(IVAL2,IVAL1)
13315#endif
13316      GOTO9000
13317C
13318C               ******************************************************
13319C               **  STEP 180--                                      **
13320C               **  TREAT THE WMF                            DRIVER **
13321C               ******************************************************
13322C
1332318000 CONTINUE
13324      GOTO9000
13325C
13326C               ******************************************************
13327C               **  STEP 190--                                      **
13328C               **  TREAT THE D3                             DRIVER **
13329C               ******************************************************
13330C
1333119000 CONTINUE
13332      GOTO9000
13333C
13334C               *****************
13335C               **  STEP 90--  **
13336C               **  EXIT       **
13337C               *****************
13338C
13339 9000 CONTINUE
13340      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'EXIT')THEN
13341        WRITE(ICOUT,999)
13342        CALL DPWRST('XXX','BUG ')
13343        WRITE(ICOUT,9011)
13344 9011   FORMAT('***** AT THE END       OF GREXIT--')
13345        CALL DPWRST('XXX','BUG ')
13346        WRITE(ICOUT,9023)NCSTR,IERRG4
13347 9023   FORMAT('NCSTR,IERRG4 = ',I8,2X,A4)
13348        CALL DPWRST('XXX','BUG ')
13349        IF(NCSTR.GT.0)THEN
13350          DO9025I=1,NCSTR
13351            CALL DPCOAN(ICSTR(I:I),IASCNE)
13352            WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
13353 9026       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
13354            CALL DPWRST('XXX','BUG ')
13355 9025     CONTINUE
13356        ENDIF
13357      ENDIF
13358C
13359      RETURN
13360      END
13361      SUBROUTINE GRFIRE(PX,PY,NP,IFIG,
13362     1                  IPATT,JPATT,IHORPA,IVERPA,
13363     1                  IDUPPA,IDDOPA,PXSPA2,PYSPA2,
13364     1                  PTHICK,JTHICK,PTHIC2,
13365     1                  ICOLF,JCOLF,ICOLP,JCOLP,
13366     1                  IPATT2)
13367C
13368C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE, FILL THE REGION DEFINED
13369C              BY THE VERTICES AS GIVEN IN THE PX(.) AND PY(.) VECTORS.
13370C     NOTE--THE COORDINATES IN (PX(.),PY(.)) ARE IN
13371C           STANDARDIZED (0.0 TO 100.0) UNITS.
13372C     NOTE--THERE ARE NP SUCH COORDINATE PAIRS.
13373C     NOTE--THIS SUBROUTINE IS CALLED BY DPFIRE, DPSCR8, AND DPFIMA
13374C
13375C     WRITTEN BY--JAMES J. FILLIBEN
13376C                 STATISTICAL ENGINEERING DIVISION
13377C                 INFORMATION TECHNOLOGY LABORATORY
13378C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
13379C                 GAITHERSBURG, MD 20899-8980
13380C                 PHONE--301-975-2855
13381C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
13382C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
13383C     LANGUAGE--ANSI FORTRAN (1977)
13384C     VERSION NUMBER--83.6
13385C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
13386C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
13387C                                      DRIVER OBSOLETE
13388C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
13389C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
13390C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
13391C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
13392C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
13393C     UPDATED         --APRIL    1989. ICOL MADE CHARACTER*4 (BOMB ON FILL)
13394C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
13395C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
13396C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
13397C                                      DRIVER OBSOLETE
13398C     UPDATED         --AUGUST   1992. POSTSCRIPT COLOR (ALAN)
13399C     UPDATED         --AUGUST   1992. SET ICOL TO ICOLP (ALAN)
13400C     UPDATED         --OCTOBER  1993. HATCH PATTERNS FOR NON-BOX AREAS
13401C                                      (ADD GRFIR3 ROUTINE) (ALAN)
13402C     UPDATED         --NOVEMBER 1993. "POLY" IN SOFTWARE (ALAN)
13403C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
13404C                                      OLD STYLE CALCOMP
13405C                                      DRIVER OBSOLETE
13406C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
13407C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
13408C                                      USE BILL MITCHELLS OPENGL
13409C                                      BINDING FOR FORTRAN
13410C     UPDATED         --OCTOBER  1996. GKS (ALAN)
13411C                                      CODED, NOT TESTED
13412C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
13413C                                      PLACEHOLDER FOR NOW
13414C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
13415C                                      PLACEHOLDER FOR NOW
13416C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
13417C     UPDATED         --DECEMBER 1997. GENERAL CODED FOR GUI
13418C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
13419C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
13420C     UPDATED         --JUNE     2000. MACINTOSH
13421C                                      PLACEHOLDER FOR NOW
13422C     UPDATED         --JUNE     2000. PC PRINTER
13423C                                      PLACEHOLDER FOR NOW
13424C     UPDATED         --JULY     2001. ADD COLOR INDEX ARGUMENT TO
13425C                                      CALLS TO GRFIR2.
13426C     UPDATED         --MARCH    2002. LATEX USING EEPIC
13427C                                      PLACEHOLDER FOR NOW
13428C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
13429C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
13430C     UPDATED         --APRIL    2009. IMPLEMENT LIBPLOT DRIVER
13431C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
13432C                                      (THESE WERE NEVER ACTUALLY IMPLENENTED)
13433C     UPDATED         --SEPTEMBER 2015. FIX GREYSCALE COLOR FOR SVG
13434C     UPDATED         --JULY      2019. TWEAK SCRATCH SPACE
13435C
13436C-----NON-COMMON VARIABLES (GRAPHICS)----------------------------------
13437C
13438#ifdef HAVE_WININTERACTER
13439      USE WINTERACTER
13440#endif
13441#ifdef HAVE_INTERACTER
13442      USE INTERACTER
13443#endif
13444      CHARACTER*4 IFIG
13445      CHARACTER*4 IPATT
13446      CHARACTER*4 IHORPA
13447      CHARACTER*4 IVERPA
13448      CHARACTER*4 IDUPPA
13449      CHARACTER*4 IDDOPA
13450      CHARACTER*4 ICOLF
13451      CHARACTER*4 ICOLP
13452      CHARACTER*4 ICOL
13453C
13454      INTEGER IGKSID
13455      INTEGER IGKSWK
13456      INTEGER IGKSTY
13457      COMMON/IGKS/IGKSID,IGKSWK,IGKSTY
13458C
13459      CHARACTER*1 ICOL2
13460      CHARACTER*2 ICJUNK
13461      CHARACTER*1 IQUOTE
13462      CHARACTER*4 IPATT2
13463      CHARACTER*4 IFLAG
13464C
13465      DIMENSION PX(*)
13466      DIMENSION PY(*)
13467C
13468      DIMENSION PX2(2)
13469      DIMENSION PY2(2)
13470C
13471      INCLUDE 'DPCOPA.INC'
13472      DIMENSION PXP(MAXPOP)
13473      DIMENSION PYP(MAXPOP)
13474      INCLUDE 'DPCOZZ.INC'
13475      EQUIVALENCE (GARBAG(JGAR12),PXP(1))
13476      EQUIVALENCE (GARBAG(JGAR15),PYP(1))
13477C
13478      DIMENSION IX(100)
13479      DIMENSION IY(100)
13480C
13481      CHARACTER*130 ICSTR
13482      CHARACTER*4 ISUBN0
13483C
13484C-----COMMON----------------------------------------------------------
13485C
13486      INCLUDE 'DPCOGR.INC'
13487      INCLUDE 'DPCONP.INC'
13488      INCLUDE 'DPCOBE.INC'
13489      INCLUDE 'DPCOST.INC'
13490      INCLUDE 'DPCODV.INC'
13491      INCLUDE 'DPCOF2.INC'
13492      PARAMETER(MAXCLR=89)
13493      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
13494C
13495      INCLUDE 'DPCOCT.INC'
13496      INCLUDE 'DPCOP2.INC'
13497C
13498C-----START POINT-----------------------------------------------------
13499C
13500C     THERE ARE 3 TYPES OF FILLS:
13501C       1. A BOX  (SOFTWARE FILL IN GRDRBP)
13502C       2. A SOLID FILLED SIMPLE (CONCAVE POLYGON) (SOFTWARE FILL IN GRFIR2)
13503C       3. A GENERAL POLYGON (SOFTWARE FILL IN GRFIR3)
13504C
13505C     HARDWARE FILLS ARE DONE FOR CASES 1 AND 2 WHERE THE HARDWARE
13506C     PERMITS.  CURRENTLY, ONLY POSTSCRIPT DOES CASE 3 IN HARDWARE.  OTHER
13507C     DEVICES MAY BE ADDED AS WE GET A CHANCE TO PROPERLY TEST THEM
13508C     (HARDWARE FILLS IN THE GENERAL CASE TEND TO BE SOMEWHAT BUGGY,
13509C     ALTHOUGH MUCH FASTER WHEN THEY WORK).
13510C
13511CCCCC OCTOBER 1993.  MODIFY ALL CALLS TO GRFIR2 TO CALL GRFIR2 FOR
13512CCCCC SOLID FILLS AND TO GO TO GRFIR3 FOR NON-SOLID FILLS.
13513CCCCC GRFIR3 CAN HANDLE CONVEX OR CONCAVE POLYGONS.
13514CCCCC ADD FOLLOWING LINES TO DETECT SOLID OR VERTICAL PATTERN
13515      IFLAG='NONS'
13516      IF(IPATT.EQ.'SOLI')IFLAG='SOLI'
13517      IF(IPATT.EQ.'FILL')IFLAG='SOLI'
13518      IF(IPATT.EQ.'ON  ')IFLAG='SOLI'
13519      IF(IPATT.EQ.'VERT')IFLAG='SOLI'
13520      IF(IPATT.EQ.'V   ')IFLAG='SOLI'
13521      IF(IFIG.EQ.'POLY')IFLAG='NONS'
13522CCCCC END CHANGE
13523      ISUBN0='FIRE'
13524C
13525      NCSTR=(-999)
13526C
13527      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'FIRE')THEN
13528        WRITE(ICOUT,999)
13529  999   FORMAT(1X)
13530        CALL DPWRST('XXX','BUG ')
13531        WRITE(ICOUT,51)
13532   51   FORMAT('***** AT THE BEGINNING OF GRFIRE--')
13533        CALL DPWRST('XXX','BUG ')
13534        WRITE(ICOUT,52)IGUNIT,NP,JPATT,IFIG,IPATT
13535   52   FORMAT('IGUNIT,NP,JPATT,IFIG,IPATT = ',3I8,2(2X,A4))
13536        CALL DPWRST('XXX','BUG ')
13537        DO55I=1,NP
13538          WRITE(ICOUT,56)PX(I),PY(I)
13539   56     FORMAT('PX(I),PY(I) = ',2G15.7)
13540          CALL DPWRST('XXX','BUG ')
13541   55   CONTINUE
13542        WRITE(ICOUT,63)IHORPA,IVERPA,IDUPPA,IDDOPA
13543   63   FORMAT('IHORPA,IVERPA,IDUPPA,IDDOPA = ',3(A4,2X),A4)
13544        CALL DPWRST('XXX','BUG ')
13545        WRITE(ICOUT,65)PXSPA2,PYSPA2,PTHICK,JTHICK,PTHIC2
13546   65   FORMAT('PXSPA2,PYSPA2,PTHICK,JTHICK,PTHIC2 = ',3G15.7,I8,G15.7)
13547        CALL DPWRST('XXX','BUG ')
13548        WRITE(ICOUT,66)ICOLF,ICOLP,JCOLF,JCOLP
13549   66   FORMAT('ICOLF,ICOLP,JCOLF,JCOLP = ',2(A4,2X),2I8)
13550        CALL DPWRST('XXX','BUG ')
13551        WRITE(ICOUT,68)IMANUF,IMODEL,ISUBG4,IERRG4
13552   68   FORMAT('IMANUF,IMODEL,ISUBG4,IERRG4 = ',3(A4,2X),A4)
13553        CALL DPWRST('XXX','BUG ')
13554      ENDIF
13555C
13556CCCCC AUGUST 1992.  SET ICOL TO ICOLP FOR GRDRBP (AFFECTS COLOR
13557CCCCC DEVICES WHEN DOING A PATTERN FILL, E.G., 'HORI').
13558      ICOL=ICOLP
13559      IF(IPATT.EQ.'SOLI')ICOL=ICOLF
13560      IF(IPATT.EQ.'FILL')ICOL=ICOLF
13561C
13562C               ********************************************
13563C               **  STEP 1--                              **
13564C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
13565C               **  AND THE MODEL                         **
13566C               ********************************************
13567C
13568      IF(IMANUF.EQ.'QWIN')THEN
13569        GOTO4700
13570      ELSEIF(IMANUF.EQ.'POST')THEN
13571        GOTO8600
13572      ELSEIF(IMANUF.EQ.'X11 ')THEN
13573        GOTO9600
13574      ELSEIF(IMANUF.EQ.'AQUA')THEN
13575        GOTO13500
13576      ELSEIF(IMANUF.EQ.'GENE')THEN
13577        IF(IMODEL.EQ.'CODE')GOTO3200
13578        IF(IMODEL.EQ.'CGM')GOTO3300
13579        IF(IMODEL.EQ.'CGMB')GOTO3400
13580        GOTO3100
13581      ELSEIF(IMANUF.EQ.'SVG ')THEN
13582        GOTO16000
13583      ELSEIF(IMANUF.EQ.'GD  ')THEN
13584        GOTO12000
13585      ELSEIF(IMANUF.EQ.'LATE')THEN
13586        GOTO15000
13587      ELSEIF(IMANUF.EQ.'CAIR')THEN
13588        GOTO17000
13589      ELSEIF(IMANUF.EQ.'D3  ')THEN
13590        GOTO19000
13591      ELSEIF(IMANUF.EQ.'WMF ')THEN
13592        GOTO18000
13593      ELSEIF(IMANUF.EQ.'OPGL')THEN
13594        GOTO4800
13595      ELSEIF(IMANUF.EQ.'TEKT')THEN
13596        IF(IMODEL.EQ.'4027')GOTO1200
13597        IF(IMODEL.EQ.'4105')GOTO1300
13598        IF(IMODEL.EQ.'4107')GOTO1300
13599        IF(IMODEL.EQ.'4109')GOTO1300
13600        IF(IMODEL.EQ.'4115')GOTO1300
13601        IF(IMODEL.EQ.'4107')GOTO1300
13602        IF(IMODEL.EQ.'4113')GOTO1300
13603        GOTO1100
13604      ELSEIF(IMANUF.EQ.'HP')THEN
13605        IF(IMODEL.EQ.'7221')GOTO2100
13606        IF(IMODEL.EQ.'2622')GOTO2300
13607        IF(IMODEL.EQ.'2623')GOTO2300
13608        IF(IMODEL.EQ.'2627')GOTO2300
13609        IF(IMODEL.EQ.'2647')GOTO2300
13610        GOTO2200
13611      ELSEIF(IMANUF.EQ.'LIBP')THEN
13612        GOTO2600
13613      ELSEIF(IMANUF.EQ.'REGI')THEN
13614        GOTO8100
13615      ELSEIF(IMANUF.EQ.'GKS ')THEN
13616        GOTO11000
13617      ELSEIF(IMANUF.EQ.'LAHE')THEN
13618        IF(IMODEL.EQ.'INTE')GOTO4900
13619        IF(IMODEL.EQ.'WINT')GOTO4950
13620        GOTO4600
13621      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
13622        GOTO13000
13623      ELSEIF(IMANUF.EQ.'QUIC')THEN
13624        GOTO9100
13625      ELSEIF(IMANUF.EQ.'CALC')THEN
13626        GOTO4100
13627      ELSEIF(IMANUF.EQ.'ZETA')THEN
13628        GOTO5100
13629      ELSEIF(IMANUF.EQ.'TURB')THEN
13630        GOTO10000
13631      ELSEIF(IMANUF.EQ.'SUN ')THEN
13632        GOTO6600
13633      ENDIF
13634      GOTO9000
13635C
13636C               **************************************************************
13637C               **  STEP 11--                                               **
13638C               **  TREAT THE TEKTRONIX 400X, 401X, 405X, AND 4114 CASES    **
13639C               **  (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES)        **
13640C               **  REFERENCE--XXX                                          **
13641C               **************************************************************
13642C
13643 1100 CONTINUE
13644      IFACTO=4
13645      IF(NUMVPP.GE.3000)IFACTO=1
13646      GOTO8900
13647C
13648C               **************************************************************
13649C               **  STEP 12--                                               **
13650C               **  TREAT THE TEKTRONIX 4027 CASE                           **
13651C               **  (COLOR RASTER DEVICE).                                  **
13652C               **  REFERENCE--XXX                                          **
13653C               **************************************************************
13654C
13655 1200 CONTINUE
13656      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
13657     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
13658      IF(IPATT.EQ.'SOLI' .OR. IPATT.EQ.'FILL')THEN
13659        DO1211I=1,NP
13660          CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0)
13661 1211   CONTINUE
13662        ICSTR(1:5)='!POL '
13663        NCSTR=5
13664        NCHTOT=6
13665        DO1215I=1,NP
13666          CALL GRTRIN(IX(I),NCHTOT,ICSTR,NCSTR)
13667          CALL GRTRIN(IY(I),NCHTOT,ICSTR,NCSTR)
13668 1215   CONTINUE
13669        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13670      ELSE
13671        IFACTO=4
13672        IF(NUMVPP.GE.3000)IFACTO=1
13673        IF(IFIG.EQ.'BOX')THEN
13674          CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
13675     1                IHORPA,IVERPA,IDUPPA,IDDOPA,
13676     1                IPATT2,PTHICK,ICOL)
13677        ELSEIF(IFIG.NE.'BOX')THEN
13678          CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
13679     1                IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
13680        ENDIF
13681      ENDIF
13682C
13683      GOTO9000
13684C
13685C               ****************************************************************
13686C               **  STEP 13--                                                 **
13687C               **  TREAT THE TEKTRONIX 4105 CASE                             **
13688C               **  (COLOR RASTER DEVICE)                                     **
13689C               **  SWITCH TO DIALOGUE MODE (AN UNDOCUMENTED NECESSITY!)      **
13690C               **  WRITE OUT ESCAPE LP FIRST-POINT,DRAW-BOUNDARY (PAGE 5-7)  **
13691C               **  LIST OUT BOUNDARY POINTS WITH DRAW COMMAND (PAGE 5-7)     **
13692C               **  WRITE OUT ESCAPE LE  TO FINISH PANEL DEFINITION           **
13693C               **  SWITCH BACK TO GRAPHICS MODE (AGAIN, UNDOCUMENTED!)       **
13694C               **  REFERENCE--PAGES 5-7, 5-17, 5-32                          **
13695C               **  REFERENCE--PAGE 5-9                                       **
13696C               ****************************************************************
13697C
13698 1300 CONTINUE
13699      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
13700     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
13701      IF(IPATT.EQ.'SOLI' .OR. IPATT.EQ.'FILL')THEN
13702        IFACTO=4
13703        IF(NUMVPP.GE.3000)IFACTO=1
13704C
13705        IF(JCOLF.EQ.0)JCOL2=48
13706        IF(JCOLF.NE.0)JCOL2=JCOLF+32
13707        CALL DPCONA(JCOL2,ICOL2)
13708        ICSTR(1:1)=IESCC
13709        ICSTR(2:3)='MP'
13710        ICSTR(4:4)=ICOL2
13711        NCSTR=4
13712        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13713C
13714        ICSTR(1:1)=IESCC
13715        ICSTR(2:4)='KA1'
13716        NCSTR=4
13717        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13718C
13719        ICSTR(1:1)=IESCC
13720        ICSTR(2:3)='LP'
13721        NCSTR=3
13722        I=1
13723        CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0)
13724        CALL TKTRPT(IX(I),IY(I),IFACTO,ICSTR,NCSTR,ISUBN0)
13725        NCSTR=NCSTR+1
13726        ICSTR(NCSTR:NCSTR)='0'
13727        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13728C
13729        ICSTR(1:1)=IESCC
13730        ICSTR(2:3)='LG'
13731        DO1315I=2,NP
13732          NCSTR=3
13733          CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0)
13734          CALL TKTRPT(IX(I),IY(I),IFACTO,ICSTR,NCSTR,ISUBN0)
13735          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13736 1315   CONTINUE
13737C
13738        ICSTR(1:1)=IESCC
13739        ICSTR(2:3)='LE'
13740        NCSTR=3
13741        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13742C
13743        ICSTR(1:1)=IESCC
13744        ICSTR(2:4)='KA0'
13745        NCSTR=4
13746        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13747      ELSE
13748        IFACTO=4
13749        IF(NUMVPP.GE.3000)IFACTO=1
13750        IF(IFIG.EQ.'BOX')THEN
13751          CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
13752     1                IHORPA,IVERPA,IDUPPA,IDDOPA,
13753     1                IPATT2,PTHICK,ICOL)
13754        ELSEIF(IFIG.NE.'BOX')THEN
13755          CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
13756     1                IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
13757        ENDIF
13758      ENDIF
13759C
13760      GOTO9000
13761C
13762C               ****************************************************
13763C               **  STEP 21--                                     **
13764C               **  TREAT THE HEWLETT-PACKARD 7221 CASE           **
13765C               **  (MULTI-COLOR PENPLOTTER)                      **
13766C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER          **
13767C               **             OPERATING AND PROGRAMMING MANUAL,  **
13768C               **             PAGE XX.                           **
13769C               ****************************************************
13770C
13771 2100 CONTINUE
13772      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
13773     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
13774      IFACTO=(-999)
13775      GOTO8900
13776C
13777C               ******************************************************
13778C               **  STEP 22--                                       **
13779C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
13780C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
13781C               **  (MULTI-COLOR PENPLOTTERS)                       **
13782C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
13783C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
13784C               **             OPERATING AND PROGRAMMING MANUAL,    **
13785C               **             PAGE XX, XXX.                        **
13786C               ******************************************************
13787C
13788 2200 CONTINUE
13789      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
13790     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
13791      IFACTO=(-999)
13792      GOTO8900
13793C
13794C               **********************************************************
13795C               **  STEP 23--                                           **
13796C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
13797C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
13798C               **  (MONOCHROME DISPLAY TERMINALS)                      **
13799C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
13800C               **             REFERENCE MANUAL,                        **
13801C               **             PAGE 10-10, XXX.                          **
13802C               **********************************************************
13803C
13804 2300 CONTINUE
13805      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
13806     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
13807      IFACTO=(-999)
13808      GOTO8900
13809C
13810C               ******************************************************
13811C               **  STEP 26--                                       **
13812C               **  TREAT THE UNIX LIBPLOT                  CASE    **
13813C               ******************************************************
13814C
13815 2600 CONTINUE
13816C
13817C     DO RECTANGULAR SOLID FILLS (BUT MAKE OPTIONAL).  FOR NOW,
13818C     DO NON-RECTANGULAR SOLID FILLS IN SOFTWARE.
13819C
13820      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
13821     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
13822      IF(IFIG.EQ.'BOX' .AND. ILPLFS.EQ.'ON')THEN
13823        IF(NP.LE.3)GOTO9000
13824        IFACT=65535/255
13825        IVALR=IFACT*IRED(JCOLF)
13826        IVALG=IFACT*IGREEN(JCOLF)
13827        IVALB=IFACT*IBLUE(JCOLF)
13828#ifdef HAVE_LIBPLOT
13829        CALL PLRGFL(DBLE(PX(1)),DBLE(PY(1)),DBLE(PX(2)),DBLE(PY(2)),
13830     1              IVALR,IVALG,IVALB)
13831#endif
13832      ELSE
13833        GOTO8900
13834      ENDIF
13835      GOTO9000
13836C
13837C               ***************************************************
13838C               **  STEP 31--                                    **
13839C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE  **
13840C               ***************************************************
13841C
13842 3100 CONTINUE
13843C
13844C     DECEMBER 1987: ADD "SET PATTERN REGION HORIZIONTAL SPACING" AND
13845C                    "SET PATTERN REGION VERTICAL SPACING" AND
13846C                    "SET PATTERN LINE" COMMANDS
13847C     JANUARY 1988: ADD A SOFTWARE SETTABLE SWITCH.  EITHER PRINT OUT
13848C                   THE DESCRIPTION OF THE PATTERN (E.G. "HORIZONTAL") OR
13849C                   HAVE DATAPLOT DO THE FILL (I.E., THE "MOVE TO" AND
13850C                   "DRAW TO" COMMANDS).
13851C
13852      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
13853     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
13854      IF(IRFLSW.EQ.'ON' .OR. IFLAG.EQ.'NONS')THEN
13855        GOTO8900
13856      ELSE
13857        ICSTR(1:11)='SET FILL ON'
13858        NCSTR=11
13859        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13860        ICSTR(1:38)='SET PATTERN REGION HORIZONTAL SPACING '
13861        NCSTR=38
13862        NCHTOT=10
13863        NCHDEC=5
13864        CALL GRTRRE(PXSPA2,NCHTOT,NCHDEC,ICSTR,NCSTR)
13865        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13866        ICSTR(1:36)='SET PATTERN REGION VERTICAL SPACING '
13867        NCSTR=36
13868        NCHTOT=10
13869        NCHDEC=5
13870        CALL GRTRRE(PYSPA2,NCHTOT,NCHDEC,ICSTR,NCSTR)
13871        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13872        ICSTR(1:24)='SET PATTERN REGION LINE '
13873        ICSTR(25:28)=IPATT2
13874        NCSTR=28
13875        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13876        ICSTR(1:11)='FILL REGION'
13877        NCSTR=11
13878        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13879        DO3120I=1,NP
13880          NCSTR=0
13881          NCHTOT=10
13882          NCHDEC=5
13883          CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
13884          CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
13885          ICSTR(11:12)='  '
13886          NCSTR=12
13887          CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
13888          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13889 3120   CONTINUE
13890        ICSTR(1:18)='END OF FILL REGION'
13891        NCSTR=18
13892        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13893      ENDIF
13894      GOTO9000
13895C
13896C               ***************************************************************
13897C               **  STEP 32--                                                **
13898C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
13899C               ***************************************************************
13900C
13901 3200 CONTINUE
13902C
13903C     DECEMBER 1987: ADD "SET PATTERN REGION HORIZIONTAL SPACING" AND
13904C                    "SET PATTERN REGION VERTICAL SPACING" AND
13905C                    "SET PATTERN LINE" COMMANDS
13906C     JANUARY 1988: ADD A SOFTWARE SETTABLE SWITCH.  EITHER PRINT OUT
13907C                   THE DESCRIPTION OF THE PATTERN (E.G. "HORIZONTAL") OR
13908C                   HAVE DATAPLOT DO THE FILL (I.E., THE "MOVE TO" AND
13909C                   "DRAW TO" COMMANDS).
13910C
13911      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
13912     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
13913      IF(IRFLSW.EQ.'ON' .OR. IFLAG.EQ.'NONS')THEN
13914        GOTO8900
13915      ELSE
13916        ICSTR(1:7)='SEFI ON'
13917        NCSTR=7
13918        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13919        ICSTR(1:31)='SEPA REGION HORIZONTAL SPACING '
13920        NCSTR=31
13921        NCHTOT=10
13922        NCHDEC=5
13923        CALL GRTRRE(PXSPA2,NCHTOT,NCHDEC,ICSTR,NCSTR)
13924        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13925        ICSTR(1:29)='SEPA REGION VERTICAL SPACING '
13926        NCSTR=29
13927        NCHTOT=10
13928        NCHDEC=5
13929        CALL GRTRRE(PYSPA2,NCHTOT,NCHDEC,ICSTR,NCSTR)
13930        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13931        ICSTR(1:17)='SEPA REGION LINE '
13932        ICSTR(18:21)=IPATT2
13933        NCSTR=21
13934        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13935        ICSTR(1:4)='FIRE'
13936        NCSTR=4
13937        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13938C
13939C       DECEMBER 1997.  FOR GUI, CODE POINTS DIFFERENTLY.
13940C
13941        IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')THEN
13942          DO3270I=1,NP
13943            NCSTR=0
13944            NCHTOT=IGENFA+3
13945            CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
13946            IPXTMP=INT(AX*10.**IGENFA+0.5)
13947            IPYTMP=INT(AY*10.**IGENFA+0.5)
13948            CALL GRTRIN(IPXTMP,NCHTOT,ICSTR,NCSTR)
13949            NCSTR=NCSTR+1
13950            ICSTR(NCSTR:NCSTR)=' '
13951            CALL GRTRIN(IPYTMP,NCHTOT,ICSTR,NCSTR)
13952            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13953 3270     CONTINUE
13954        ELSE
13955          DO3220I=1,NP
13956            NCSTR=0
13957            NCHTOT=10
13958            NCHDEC=5
13959            CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
13960            CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
13961            ICSTR(11:12)='  '
13962            NCSTR=12
13963            CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
13964            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13965 3220     CONTINUE
13966        ENDIF
13967      ENDIF
13968C
13969      GOTO9000
13970C
13971C               ***************************************************
13972C               **  STEP 33--                                    **
13973C               **  TREAT THE GENERAL (CGM               ) CASE  **
13974C               ***************************************************
13975C
13976 3300 CONTINUE
13977C
13978      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
13979     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
13980      IF(IRFLSW.EQ.'ON' .OR. IFLAG.EQ.'NONS')THEN
13981        GOTO8900
13982      ELSE
13983        ICSTR(1:7)='POLYGON'
13984        NCSTR=7
13985        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13986        NCHTOT=10
13987        NCHDEC=5
13988        DO3340I=1,NP
13989          NCSTR=0
13990          CALL GRTRSA(PX(I),PY(I),AX,AY,ISUBN0)
13991          CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
13992          ICSTR(11:12)=', '
13993          NCSTR=12
13994          CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
13995          ICSTR(23:23)=','
13996          IF(I.EQ.NP)ICSTR(23:23)=';'
13997          NCSTR=23
13998          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
13999 3340   CONTINUE
14000      ENDIF
14001      GOTO9000
14002C
14003C               ***************************************************
14004C               **  STEP 34--                                    **
14005C               **  TREAT THE GENERAL (CGM BINARY        ) CASE  **
14006C               ***************************************************
14007C
14008 3400 CONTINUE
14009C
14010      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14011     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14012      IF(IRFLSW.EQ.'ON' .OR. IFLAG.EQ.'NONS')THEN
14013        GOTO8900
14014      ELSE
14015        CONTINUE
14016      ENDIF
14017      GOTO9000
14018C
14019C               ******************************************************
14020C               **  STEP 41--                                       **
14021C               **  TREAT THE CALCOMP XXXXXX CASE                   **
14022C               **  TO SET FILL--                                   **
14023C               **  WRITE OUT AN XXXXXXXXXX                         **
14024C               **  (NOT DONE)                                      **
14025C               **  REFERENCE--CALCOMP LIBRARY ROUTINE              **
14026C               **             XX                                   **
14027C               **             PAGES XX AND XX                      **
14028C               ******************************************************
14029C
14030 4100 CONTINUE
14031      IFACTO=-999
14032      GOTO8900
14033C
14034C               ******************************************************
14035C               **  STEP 46--                                       **
14036C               **  TREAT THE LAHEY   XXXXXX CASE                   **
14037C               **  REFERENCE--Programmer's Reference, Revision C   **
14038C               **             Lahey Computer Systems, January, 1992**
14039C               **             PAGES 51 THRU 65                     **
14040C               ******************************************************
14041C
14042 4600 CONTINUE
14043      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14044     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14045      IF(IPATT.EQ.'SOLI' .OR. IPATT.EQ.'FILL')THEN
14046#ifdef HAVE_LAHEY_CALCOMP
14047        CALL NEWPEN(JCOLF)
14048        ILAHCC=JCOLF
14049        CALL FILL(NP,PX,PY)
14050#endif
14051      ELSE
14052        IFACTO=-999
14053        GOTO8900
14054      ENDIF
14055      GOTO9000
14056C
14057C               ******************************************************
14058C               **  STEP 47--                                       **
14059C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
14060C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
14061C               ******************************************************
14062C
14063 4700 CONTINUE
14064      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14065     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14066      GOTO8900
14067C
14068C               ******************************************************
14069C               **  STEP 48--                                       **
14070C               **  TREAT THE OPEN-GL DRIVER                        **
14071C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
14072C               ******************************************************
14073C
14074 4800 CONTINUE
14075      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14076     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14077      IF(IPATT.EQ.'SOLI' .OR. IPATT.EQ.'FILL')THEN
14078        IF(IFIG.EQ.'BOX')THEN
14079          PX2(1)=PX(1)
14080          PY2(1)=PY(1)
14081          PX2(2)=PX(3)
14082          PY2(2)=PY(3)
14083          NP2=2
14084#ifdef HAVE_OPEN_GL
14085          CALL GLREFL(PX2,PY2,NP2)
14086#endif
14087        ELSE
14088#ifdef HAVE_OPEN_GL
14089          CALL GLREFL(PX,PY,NP)
14090#endif
14091        END IF
14092      ELSE
14093        IFACTO=-999
14094        GOTO8900
14095      ENDIF
14096      GOTO9000
14097C
14098C               ******************************************************
14099C               **  STEP 49--                                       **
14100C               **  TREAT THE LAHEY INTERACTOR CASE                 **
14101C               ******************************************************
14102C
14103 4900 CONTINUE
14104      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14105     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14106      IF(IPATT.EQ.'SOLI' .OR. IPATT.EQ.'FILL')THEN
14107        ISTYLE=4
14108        IDENSE=0
14109        IANGLE=0
14110#ifdef HAVE_INTERACTER
14111        CALL IGrFillPattern(ISTYLE,IDENSE,IANGLE)
14112        CALL IGrPolygonComplex(REAL(IX),REAL(IY),NP)
14113        CALL IGrPolygonComplex(PX,PY,NP)
14114#endif
14115      ELSE
14116        IFACTO=-999
14117        GOTO8900
14118      ENDIF
14119      GOTO9000
14120C
14121C               ******************************************************
14122C               **  STEP 49B-                                       **
14123C               **  TREAT THE LAHEY WINTERACTOR CASE                **
14124C               ******************************************************
14125C
14126 4950 CONTINUE
14127      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14128     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14129      IF(IPATT.EQ.'SOLI' .OR. IPATT.EQ.'FILL')THEN
14130        IF(NP.LE.2)GOTO9000
14131        ISTYLE=4
14132        IDENSE=0
14133        IANGLE=0
14134#ifdef HAVE_WININTERACTER
14135        CALL IGrFillPattern(ISTYLE,IDENSE,IANGLE)
14136        CALL IGrPolygonComplex(PX,PY,NP)
14137#endif
14138      ELSE
14139        IFACTO=-999
14140        GOTO8900
14141      ENDIF
14142      GOTO9000
14143C
14144C
14145C               ******************************************************
14146C               **  STEP 51--                                       **
14147C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
14148C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
14149C               **             MODELS 3600SX AND 3653SX             **
14150C               **             PAGES B-0 AND B-1                    **
14151C               **  USE CALCOMP LIBRARY ROUTINE                     **
14152C               ******************************************************
14153C
14154 5100 CONTINUE
14155      IFACTO=-999
14156      GOTO8900
14157C
14158C               ****************************************************
14159C               **  STEP 66--                                     **
14160C               **  TREAT THE SUN - WRITTEN BY BILL ANDERSON      **
14161C               ****************************************************
14162C
14163 6600 CONTINUE
14164      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14165     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14166      IF(IPATT.EQ.'SOLI' .OR. IPATT.EQ.'FILL')THEN
14167        DO6611I=1,NP
14168          CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0)
14169 6611   CONTINUE
14170#ifdef HAVE_SUN
14171        CALL cfflcolor(JCOLF)
14172        CALL cfperimcolor(JCOLP)
14173        CALL cfpolygon(IX,IY,NP)
14174#endif
14175      ELSE
14176        IFACTO=-999
14177        GOTO8900
14178      ENDIF
14179      GOTO9000
14180C
14181C               ******************************************************
14182C               **  STEP 81--                                       **
14183C               **  TREAT THE DEC REGIS      CASE                   **
14184C               **  TO FILL REG--                                   **
14185C               **  WRITE OUT AN                                    **
14186C               **    P[IX,IY]  - MOVE TO FIRST POINT               **
14187C               **    W(S1)     - ENABLE SHADING (SOLID FILL)       **
14188C               **    V[IX(I),IY(I)] - DRAW VECTOR ON REGION TO BE  **
14189C               **                     FILLED                       **
14190C               **    W(S0)     - DISABLE SHADING
14191C               **  (NOT DONE)                                      **
14192C               **  REFERENCE--VT 240 PROGRAMMER REFERENCE MANUAL   **
14193C               **             DEC (OCTOBER, 1983 EDITION)          **
14194C               **             PAGES 5-90 THRU 5-103                **
14195C               ******************************************************
14196C
14197 8100 CONTINUE
14198      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14199     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14200      IF(IPATT.EQ.'SOLI' .OR. IPATT.EQ.'FILL')THEN
14201        DO8111I=1,NP
14202          CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0)
14203 8111   CONTINUE
14204        ICSTR(1:2)='P['
14205        NCSTR=2
14206        NCHTOT=5
14207        CALL GRTRIN(IX(1),NCHTOT,ICSTR,NCSTR)
14208        ICSTR(8:8)=','
14209        NCSTR=8
14210        CALL GRTRIN(IY(1),NCHTOT,ICSTR,NCSTR)
14211        ICSTR(14:14)=']'
14212        NCSTR=14
14213        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14214        ICSTR(1:5)='W(S1)'
14215        NCSTR=5
14216        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14217        DO8115I=1,NP
14218          ICSTR(1:2)='V['
14219          NCSTR=2
14220          NCHTOT=5
14221          CALL GRTRIN(IX(I),NCHTOT,ICSTR,NCSTR)
14222          ICSTR(8:8)=','
14223          NCSTR=8
14224          CALL GRTRIN(IY(I),NCHTOT,ICSTR,NCSTR)
14225          ICSTR(14:14)=']'
14226          NCSTR=14
14227          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14228 8115   CONTINUE
14229        ICSTR(1:5)='W(S0)'
14230        NCSTR=5
14231        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14232      ELSE
14233        IFACTO=-999
14234        GOTO8900
14235      ENDIF
14236C
14237      GOTO9000
14238C
14239C               ******************************************************
14240C               **  STEP 86--                                       **
14241C               **  TREAT THE POSTSCRIPT           CASE             **
14242C               **  TO FILL REG--                                   **
14243C               **  <SHAD> SETGREY - SET GREY SCALE FOR SOLID FILL  **
14244C               **  <X Y COOR PAIRS> FILL                           **
14245C               **  REFERENCE--POSTSCRIPT LANGUAGE COOKBOOK AND     **
14246C               **             TUTORIAL FROM ADOBE SYSTEMS          **
14247C               **             PAGES XX AND XX                      **
14248C               **  MODIFIED JANUARY, 1990 TO SUPPORT COLOR.  IF    **
14249C               **  COLOR TURNED ON, COLOR FOR REGIONS SET IN       **
14250C               **  GRSECO, IF NOT THEN USE GREY SCALE FOR SOLID    **
14251C               **  FILL REGIONS.                                   **
14252C               ******************************************************
14253C
14254 8600 CONTINUE
14255      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14256     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14257      IF(IPATT.EQ.'SOLI' .OR. IPATT.EQ.'FILL')THEN
14258        IF(NP.LE.3)GOTO9000
14259        NCHTOT=5
14260        NCSTR=0
14261        CALL GRTRSD(PX(1),PY(1),IXTEMP,IYTEMP,ISUBN0)
14262        CALL GRTRIN(IXTEMP,NCHTOT,ICSTR,NCSTR)
14263        ICSTR(6:6)=' '
14264        NCSTR=6
14265        CALL GRTRIN(IYTEMP,NCHTOT,ICSTR,NCSTR)
14266        ICSTR(12:13)=' m'
14267        NCSTR=13
14268        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14269        DO8611I=2,NP
14270          NCSTR=0
14271          CALL GRTRSD(PX(I),PY(I),IXTEMP,IYTEMP,ISUBN0)
14272          CALL GRTRIN(IXTEMP,NCHTOT,ICSTR,NCSTR)
14273          ICSTR(6:6)=' '
14274          NCSTR=6
14275          CALL GRTRIN(IYTEMP,NCHTOT,ICSTR,NCSTR)
14276          ICSTR(12:13)=' l'
14277          NCSTR=13
14278          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14279 8611   CONTINUE
14280        IF(IGCOLO.EQ.'ON')THEN
14281          ICSTR(1:35)='closepath fill 0. 0. 0. setrgbcolor'
14282          NCSTR=35
14283        ELSE
14284          ICSTR(1:25)='closepath fill 0. setgray'
14285          NCSTR=25
14286        ENDIF
14287        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14288      ELSE
14289        IFACTO=-999
14290        GOTO8900
14291      ENDIF
14292C
14293      GOTO9000
14294C
14295C               ******************************************************
14296C               **  STEP 91--                                       **
14297C               **  TREAT THE QUIC           CASE                   **
14298C               **  TO FILL REG--                                   **
14299C               **  WRITE OUT AN ^LAFhhhhhvvvvv20^G                 **
14300C               **  IF PICK POINT IN MIDDLE OF REGION, WILL HARDWARE**
14301C               **  FILL TO LINES FORMING REGION AROUND THAT POINT. **
14302C               **  NOTE THAT FOR DATAPLOT, THE REGION BORDER MAY   **
14303C               **  BE BLANK, WHICH CAN CAUSE DISASTOROUS RESULTS,  **
14304C               **  ALSO DEPENDS ON BORDER BEING DRAW FIRST, WHICH  **
14305C               **  IS NOT GARUNTEED IN DATAPLOT                    **
14306C               **  THERFORE DO A SOFTWARE REGION FILL              **
14307C               **  REFERENCE--QUIC PROGRAMMERS MANUAL,             **
14308C               **             CHAPTER 8                            **
14309C               ******************************************************
14310C
14311 9100 CONTINUE
14312      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14313     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14314      IFACTO=-999
14315      GOTO8900
14316C
14317C               ******************************************************
14318C               **  STEP 96--                                       **
14319C               **  TREAT THE X11        CASE                       **
14320C               **  SOLID FILLS DONE BY XLIB, PATTERNED FILLS WITH  **
14321C               **  SOFTWARE                                        **
14322C               ******************************************************
14323C
14324 9600 CONTINUE
14325#ifdef HAVE_X11
14326      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14327     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14328      IF(IX11FS.EQ.'OFF'.AND.IFIG.NE.'BOX')THEN
14329        IFACTO=-999
14330        GOTO8900
14331      ELSEIF(IPATT.EQ.'SOLI' .OR. IPATT.EQ.'FILL')THEN
14332        IF(NP.LE.3)GOTO9000
14333        CALL GRTRSD(PX(1),PY(1),IX(1),IY(1),ISUBN0)
14334        IF(IFIG.EQ.'BOX')THEN
14335          CALL GRTRSD(PX(3),PY(3),IX(2),IY(2),ISUBN0)
14336          NTEMP=2
14337        ELSE
14338          DO9611I=2,NP
14339            CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0)
14340 9611     CONTINUE
14341          NTEMP=NP
14342        END IF
14343        CALL XREGFL(IX,IY,NTEMP)
14344      ELSE
14345        IFACTO=-999
14346        GOTO8900
14347      ENDIF
14348C
14349#endif
14350      GOTO9000
14351C
14352CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
14353C               *************************************************
14354C               **  STEP 100--                                 **
14355C               **  TREAT THE VGA VIA TURBO-C       CASE       **
14356C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
14357C               **             ENHANCEMENTS, PAGE 71.          **
14358C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
14359C               **             PAGE 122.                       **
14360C               **  REFERENCE--WEISKAMP, POWER GRAPHICS        **
14361C               **             USING TURBO C, PAGE 13-16, 39-50**
14362C               *************************************************
14363C
1436410000 CONTINUE
14365      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14366     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14367      IF(IPATT.EQ.'SOLI' .OR. IPATT.EQ.'FILL')THEN
14368        IF(NP.LE.3)GOTO9000
14369        CALL GRTRSD(PX(1),PY(1),IX(1),IY(1),ISUBN0)
14370        IF(IFIG.EQ.'BOX')THEN
14371           CALL GRTRSD(PX(3),PY(3),IX(2),IY(2),ISUBN0)
14372           NTEMP=2
14373        ELSE
14374           DO10611I=2,NP
14375             CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0)
1437610611      CONTINUE
14377           NTEMP=NP
14378        END IF
14379CTURB CALL TCFIRE(IX,IY,NTEMP)
14380      ELSE
14381        IFACTO=-999
14382        GOTO8900
14383      ENDIF
14384      GOTO9000
14385C
14386C               ******************************************************
14387C               **  STEP 110--                                      **
14388C               **  TREAT THE GKS                DRIVER             **
14389C               ******************************************************
14390C
1439111000 CONTINUE
14392      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14393     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14394      IF(IPATT.EQ.'SOLI' .OR. IPATT.EQ.'FILL')THEN
14395        IF(NP.LE.3)GOTO9000
14396#ifdef HAVE_GKS
14397        CALL GFA(PX,PY,NTEMP)
14398#endif
14399      ELSE
14400        IFACTO=-999
14401        GOTO8900
14402      ENDIF
14403      GOTO9000
14404C
14405C               ******************************************************
14406C               **  STEP 120--                                      **
14407C               **  TREAT THE GD                     DRIVER         **
14408C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
14409C               **  1) JPEG                                         **
14410C               **  2) PNG                                          **
14411C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
14412C               ******************************************************
14413C
1441412000 CONTINUE
14415CCCCC GD SOLID FILL FOR NON-RECTANGULAR REGIONS BLOWS UP FOR
14416CCCCC PIE CHARTS (MAYBE OTHERS).  MAKE SWITCHABLE, BUT FOR NOW
14417CCCCC SIMPLY DO NON-RECTANGULAR SOLID FILLS IN SOFTWARE.
14418CCCCC IF(IGDFS.EQ.'OFF'.AND.IFIG.NE.'BOX')GOTO12030
14419C
14420      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14421     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14422      IF(IPATT.EQ.'SOLI' .OR. IPATT.EQ.'FILL' .AND. IFIG.EQ.'BOX')THEN
14423        IF(NP.LE.3)GOTO9000
14424        CALL GRTRSD(PX(1),PY(1),IX(1),IY(1),ISUBN0)
14425        IF(IFIG.EQ.'BOX')THEN
14426          CALL GRTRSD(PX(3),PY(3),IX(2),IY(2),ISUBN0)
14427          NTEMP=2
14428        ELSE
14429          DO12011I=2,MAX(100,NP)
14430            CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0)
1443112011     CONTINUE
14432          NTEMP=NP
14433        END IF
14434#ifdef HAVE_GD
14435      CALL GDRGFL(IX,IY,NTEMP,JCOLF)
14436#endif
14437      ELSE
14438        IFACTO=-999
14439        GOTO8900
14440      ENDIF
14441      GOTO9000
14442C
14443C               ******************************************************
14444C               **  STEP 130--                                      **
14445C               **  TREAT THE ABSOFT                 DRIVER         **
14446C               **  LIBRARY FROM ABSOFT COMPILER                    **
14447C               ******************************************************
14448C
1444913000 CONTINUE
14450      GOTO9000
14451C
14452C               ******************************************************
14453C               **  STEP 135--                                      **
14454C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
14455C               ******************************************************
14456C
1445713500 CONTINUE
14458C
14459      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14460     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14461      IF(IPATT.EQ.'SOLI' .OR. IPATT.EQ.'FILL' .AND. IAQUFS.EQ.'ON')THEN
14462        IF(NP.LE.3)GOTO9000
14463        IF(IFIG.EQ.'BOX')THEN
14464          CALL GRTRSD(PX(1),PY(1),IX1,IY1,ISUBN0)
14465          CALL GRTRSD(PX(3),PY(3),IX2,IY2,ISUBN0)
14466          IF(IX2.LT.IX1)THEN
14467            IXTEMP=IX2
14468            IX2=IX1
14469            IX1=IXTEMP
14470          ENDIF
14471          IX2=IX2-IX1
14472          IF(IY2.LT.IY1)THEN
14473            IYTEMP=IY2
14474            IY2=IY1
14475            IY1=IYTEMP
14476          ENDIF
14477          IY2=IY2-IY1
14478COLD      CALL aqtAddFilledRect(AX1,AX2,AY1,AY2)
14479#ifdef HAVE_AQUA
14480          CALL aqrect(IX1,IY1,IX2,IY2)
14481#endif
14482        ELSE
14483C
14484C         FOR AQUATERM, LIMIT MAXIMUM NUMBER OF POINTS IN
14485C         REGION TO 100 POINTS.
14486C
14487          DO13511I=1,MAX(100,NP)
14488            CALL GRTRSD(PX(I),PY(I),IX1,IY1,ISUBN0)
14489            PXP(I)=REAL(IX1)
14490            PYP(I)=REAL(IY1)
1449113511     CONTINUE
14492          NTEMP=NP
14493#ifdef HAVE_AQUA
14494          CALL aqrgfl(PXP,PYP,NTEMP)
14495#endif
14496        END IF
14497      ELSE
14498        IFACTO=-999
14499        GOTO8900
14500      ENDIF
14501      GOTO9000
14502C
14503C               ******************************************************
14504C               **  STEP 150--                                      **
14505C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
14506C               ******************************************************
14507C
1450815000 CONTINUE
14509C
14510      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14511     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14512      IFACTO=-999
14513      GOTO8900
14514C
14515C               ******************************************************
14516C               **  STEP 160--                                      **
14517C               **  TREAT THE SVG (SCALABE VECTOR GRAPHICS) DRIVER  **
14518C               ******************************************************
14519C
1452016000 CONTINUE
14521C
14522      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14523     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14524      CALL DPCONA(34,IQUOTE)
14525C
14526      IF(ISVGFS.EQ.'OFF'.AND.IFIG.NE.'BOX')GOTO8900
14527      IF(IPATT.EQ.'SOLI' .OR. IPATT.EQ.'FILL')THEN
14528        IF(NP.LE.3)GOTO9000
14529        CALL GRTRSD(PX(1),PY(1),IX(1),IY(1),ISUBN0)
14530        IF(IFIG.EQ.'BOX')THEN
14531          CALL GRTRSD(PX(3),PY(3),IX(2),IY(2),ISUBN0)
14532          IF(IX(1).LE.IX(2))THEN
14533            IXSTRT=IX(1)
14534            IXSTOP=IX(2)
14535          ELSE
14536            IXSTRT=IX(2)
14537            IXSTOP=IX(1)
14538          ENDIF
14539          IF(IY(1).LE.IY(2))THEN
14540            IYSTRT=IY(1)
14541            IYSTOP=IY(2)
14542          ELSE
14543            IYSTRT=IY(2)
14544            IYSTOP=IY(1)
14545          ENDIF
14546          IWID=IXSTOP-IXSTRT+1
14547          IHEIG=IYSTOP-IYSTRT+1
14548C
14549          ICSTR(1:11)='   <rect x='
14550          ICSTR(12:12)=IQUOTE
14551          NCSTR=12
14552          IF(IXSTRT.GE.10000)THEN
14553            NCHTOT=5
14554          ELSEIF(IXSTRT.GE.1000)THEN
14555            NCHTOT=4
14556          ELSEIF(IXSTRT.GE.100)THEN
14557            NCHTOT=3
14558          ELSEIF(IXSTRT.GE.10)THEN
14559            NCHTOT=2
14560          ELSE
14561            NCHTOT=1
14562          ENDIF
14563          CALL GRTRIN(IXSTRT,NCHTOT,ICSTR,NCSTR)
14564          NCSTR=NCSTR+1
14565          ICSTR(NCSTR:NCSTR)=IQUOTE
14566          NCSTR=NCSTR+1
14567          ICSTR(NCSTR:NCSTR+2)=' y='
14568          NCSTR=NCSTR+3
14569          ICSTR(NCSTR:NCSTR)=IQUOTE
14570          IF(IYSTRT.GE.10000)THEN
14571            NCHTOT=5
14572          ELSEIF(IYSTRT.GE.1000)THEN
14573            NCHTOT=4
14574          ELSEIF(IYSTRT.GE.100)THEN
14575            NCHTOT=3
14576          ELSEIF(IYSTRT.GE.10)THEN
14577            NCHTOT=2
14578          ELSE
14579            NCHTOT=1
14580          ENDIF
14581          CALL GRTRIN(IYSTRT,NCHTOT,ICSTR,NCSTR)
14582          NCSTR=NCSTR+1
14583          ICSTR(NCSTR:NCSTR)=IQUOTE
14584          NCSTR=-NCSTR
14585          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14586C
14587          ICSTR(1:15)='         width='
14588          ICSTR(16:16)=IQUOTE
14589          NCSTR=16
14590          IF(IWID.GE.10000)THEN
14591            NCHTOT=5
14592          ELSEIF(IWID.GE.1000)THEN
14593            NCHTOT=4
14594          ELSEIF(IWID.GE.100)THEN
14595            NCHTOT=3
14596          ELSEIF(IWID.GE.10)THEN
14597            NCHTOT=2
14598          ELSE
14599            NCHTOT=1
14600          ENDIF
14601          CALL GRTRIN(IWID,NCHTOT,ICSTR,NCSTR)
14602          NCSTR=NCSTR+1
14603          ICSTR(NCSTR:NCSTR)=IQUOTE
14604          NCSTR=NCSTR+1
14605          ICSTR(NCSTR:NCSTR+7)=' height='
14606          NCSTR=NCSTR+8
14607          ICSTR(NCSTR:NCSTR)=IQUOTE
14608          IF(IHEIG.GE.10000)THEN
14609            NCHTOT=5
14610          ELSEIF(IHEIG.GE.1000)THEN
14611            NCHTOT=4
14612          ELSEIF(IHEIG.GE.100)THEN
14613            NCHTOT=3
14614          ELSEIF(IHEIG.GE.10)THEN
14615            NCHTOT=2
14616          ELSE
14617            NCHTOT=1
14618          ENDIF
14619          CALL GRTRIN(IHEIG,NCHTOT,ICSTR,NCSTR)
14620          NCSTR=NCSTR+1
14621          ICSTR(NCSTR:NCSTR)=IQUOTE
14622          NCSTR=-NCSTR
14623          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14624C
14625          ICSTR(1:17)='           style='
14626          ICSTR(18:18)=IQUOTE
14627          ICSTR(19:31)='stroke:none; '
14628          NCSTR=-31
14629          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14630          ICSTR(1:19)='             fill:#'
14631          NCSTR=19
14632          NCHTOT=2
14633          JTEMP=JCOLF
14634          IF(JTEMP.LE.0)THEN
14635C
14636C           DATAPLOT CURRENTLY ALLOWS GREYSCALE VALUES IN
14637C           THE RANGE 0 TO 100.  FOR SPECIFYING COLOR TO SVG,
14638C           SCALE THAT 0 TO 100 VALUE TO A 0 TO 255 VALUE.
14639C
14640            AVAL=(255./100.)*REAL(ABS(JTEMP))
14641            IF(AVAL.LE.0.0)AVAL=0.0
14642            IF(AVAL.GE.255.0)AVAL=255.0
14643            JRED=INT(AVAL+0.5)
14644            JBLUE=JRED
14645            JGREEN=JRED
14646          ELSE
14647            IF(JTEMP.LT.1 .OR. JTEMP.GT.MAXCLR)JTEMP=1
14648            JRED=IRED(JTEMP)
14649            JGREEN=IGREEN(JTEMP)
14650            JBLUE=IBLUE(JTEMP)
14651          ENDIF
14652          CALL DPCONX(JRED,ICJUNK)
14653          NCSTR=NCSTR+1
14654          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
14655          NCSTR=NCSTR+1
14656          CALL DPCONX(JGREEN,ICJUNK)
14657          NCSTR=NCSTR+1
14658          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
14659          NCSTR=NCSTR+1
14660          CALL DPCONX(JBLUE,ICJUNK)
14661          NCSTR=NCSTR+1
14662          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
14663          NCSTR=NCSTR+2
14664          ICSTR(NCSTR:NCSTR)=IQUOTE
14665          NCSTR=-NCSTR
14666          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14667          ICSTR(1:7)='     />'
14668          NCSTR=-7
14669          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14670C
14671        ELSE
14672          ICSTR(1:11)='   <polygon'
14673          NCSTR=-11
14674          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14675          ICSTR(1:17)='           style='
14676          ICSTR(18:18)=IQUOTE
14677          ICSTR(19:31)='stroke:none; '
14678          NCSTR=-31
14679          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14680          ICSTR(1:19)='             fill:#'
14681          NCSTR=19
14682          NCHTOT=2
14683          JTEMP=JCOLF
14684          IF(JTEMP.LE.0)THEN
14685C
14686C           DATAPLOT CURRENTLY ALLOWS GREYSCALE VALUES IN
14687C           THE RANGE 0 TO 100.  FOR SPECIFYING COLOR TO SVG,
14688C           SCALE THAT 0 TO 100 VALUE TO A 0 TO 255 VALUE.
14689C
14690            AVAL=(255./100.)*REAL(ABS(JTEMP))
14691            IF(AVAL.LE.0.0)AVAL=0.0
14692            IF(AVAL.GE.255.0)AVAL=255.0
14693            JRED=INT(AVAL+0.5)
14694            JBLUE=JRED
14695            JGREEN=JRED
14696          ELSE
14697            IF(JTEMP.LT.1 .OR. JTEMP.GT.MAXCLR)JTEMP=1
14698            JRED=IRED(JTEMP)
14699            JGREEN=IGREEN(JTEMP)
14700            JBLUE=IBLUE(JTEMP)
14701          ENDIF
14702          CALL DPCONX(JRED,ICJUNK)
14703          NCSTR=NCSTR+1
14704          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
14705          NCSTR=NCSTR+1
14706          CALL DPCONX(JGREEN,ICJUNK)
14707          NCSTR=NCSTR+1
14708          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
14709          NCSTR=NCSTR+1
14710          CALL DPCONX(JBLUE,ICJUNK)
14711          NCSTR=NCSTR+1
14712          ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
14713          NCSTR=NCSTR+2
14714          ICSTR(NCSTR:NCSTR)=IQUOTE
14715          NCSTR=-NCSTR
14716          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14717          ICSTR(1:12)='     points='
14718          NCSTR=13
14719          ICSTR(NCSTR:NCSTR)=IQUOTE
14720          NCSTR=-NCSTR
14721          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14722          NCHTOT=5
14723C
14724          NCSTR=0
14725          DO16011I=1,NP
14726            IF(NCSTR.GT.80)THEN
14727              NCSTR=-NCSTR
14728              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14729              NCSTR=3
14730              ICSTR(1:NCSTR)='   '
14731            ENDIF
14732            CALL GRTRSD(PX(I),PY(I),IXTEMP,IYTEMP,ISUBN0)
14733            CALL GRTRIN(IXTEMP,NCHTOT,ICSTR,NCSTR)
14734            NCSTR=NCSTR+1
14735            ICSTR(NCSTR:NCSTR)=','
14736            CALL GRTRIN(IYTEMP,NCHTOT,ICSTR,NCSTR)
14737            NCSTR=NCSTR+1
14738            ICSTR(NCSTR:NCSTR)=' '
14739            IF(NCSTR.LE.80)GOTO16011
14740            NCSTR=-NCSTR
14741            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14742            NCSTR=3
14743            ICSTR(1:NCSTR)='   '
1474416011     CONTINUE
14745C
14746          IF(NCSTR.GT.3)THEN
14747            NCSTR=-NCSTR
14748            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14749          ENDIF
14750C
14751          ICSTR(1:3)='   '
14752          ICSTR(4:4)=IQUOTE
14753          ICSTR(5:6)='/>'
14754          NCSTR=-6
14755          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
14756        END IF
14757      ELSE
14758        IFACTO=-999
14759        GOTO8900
14760      ENDIF
14761      GOTO9000
14762C
14763C               ******************************************************
14764C               **  STEP 170--                                      **
14765C               **  TREAT THE CAIRO                          DRIVER **
14766C               ******************************************************
14767C
1476817000 CONTINUE
14769#ifdef HAVE_CAIRO
14770C
14771      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14772     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14773C
14774C     FILL IN SOFTWARE
14775C
14776      IF(ICAIFS.EQ.'OFF'.AND.IFIG.NE.'BOX')THEN
14777        IFACTO=-999
14778        GOTO8900
14779      ENDIF
14780C
14781      IF(IPATT.EQ.'SOLI' .OR. IPATT.EQ.'FILL')THEN
14782        IF(NP.LE.3)GOTO9000
14783C
14784        IVAL2=1
14785        IF(IGUNIT.EQ.IPL1NU)IVAL2=2
14786        IF(IGUNIT.EQ.IPL2NU)IVAL2=3
14787C
14788        PX2(1)=PX(1)
14789        PY2(1)=PY(1)
14790        CALL GRTRSD(PX2(1),PY2(1),IX(1),IY(1),ISUBN0)
14791        IF(IFIG.EQ.'BOX')THEN
14792          PX2(2)=PX(3)
14793          PY2(2)=PY(3)
14794          CALL GRTRSD(PX2(2),PY2(2),IX(2),IY(2),ISUBN0)
14795          NTEMP=2
14796          CALL CARGFL(IVAL2,PX2,PY2,NTEMP)
14797        ELSE
14798          DO17011I=1,NP
14799            PXP(I)=PX(I)
14800            PYP(I)=PY(I)
14801            CALL GRTRSD(PXP(I),PYP(I),IX1,IY1,ISUBN0)
1480217011     CONTINUE
14803          NTEMP=NP
14804          CALL CARGFL(IVAL2,PXP,PYP,NTEMP)
14805        END IF
14806      ELSE
14807        IFACTO=-999
14808        GOTO8900
14809      ENDIF
14810#endif
14811      GOTO9000
14812C
14813C               ******************************************************
14814C               **  STEP 180--                                      **
14815C               **  TREAT THE WMF                            DRIVER **
14816C               ******************************************************
14817C
1481818000 CONTINUE
14819      GOTO9000
14820C
14821C               ******************************************************
14822C               **  STEP 190--                                      **
14823C               **  TREAT THE D3                             DRIVER **
14824C               ******************************************************
14825C
1482619000 CONTINUE
14827      GOTO9000
14828C
14829C               ******************************************************
14830C               **  STEP 99--GENERIC CODE FOR DEVICES THAT DO NOT   **
14831C               **           SUPPORT HARDWARE FILLS                 **
14832C               ******************************************************
14833C
14834 8900 CONTINUE
14835      IF(IPATT.EQ.'EMPT' .OR. IPATT.EQ.'BLAN' .OR. IPATT.EQ.'    ' .OR.
14836     1   IPATT.EQ.'NONE' .OR. NP.LE.1)GOTO9000
14837      IF(IFIG.EQ.'BOX')THEN
14838        CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
14839     1              IHORPA,IVERPA,IDUPPA,IDDOPA,
14840     1              IPATT2,PTHICK,ICOL)
14841      ELSEIF(IFIG.NE.'BOX')THEN
14842        IF(IFLAG.EQ.'SOLI')THEN
14843          CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
14844     1              IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF)
14845        ELSE
14846          CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO,
14847     1              IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL)
14848        ENDIF
14849      ENDIF
14850      GOTO9000
14851C
14852C               *****************
14853C               **  STEP 90--  **
14854C               **  EXIT       **
14855C               *****************
14856C
14857 9000 CONTINUE
14858      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'FIRE')THEN
14859        WRITE(ICOUT,999)
14860        CALL DPWRST('XXX','BUG ')
14861        WRITE(ICOUT,9011)
14862 9011   FORMAT('***** AT THE END       OF GRFIRE--')
14863        CALL DPWRST('XXX','BUG ')
14864        DO9015I=1,NP
14865          WRITE(ICOUT,9016)PX(I),PY(I),IX(I),IY(I)
14866 9016     FORMAT('PX(I),PY(I),IX(I),IY(I) = ',2G15.7,2I8)
14867          CALL DPWRST('XXX','BUG ')
14868 9015   CONTINUE
14869C
14870        WRITE(ICOUT,9033)NCSTR
14871 9033   FORMAT('NCSTR = ',I8)
14872        CALL DPWRST('XXX','BUG ')
14873        IF(NCSTR.GE.1)THEN
14874          DO9035I=1,NCSTR
14875            CALL DPCOAN(ICSTR(I:I),IASCNE)
14876            WRITE(ICOUT,9036)I,ICSTR(I:I),IASCNE
14877 9036       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
14878            CALL DPWRST('XXX','BUG ')
14879 9035     CONTINUE
14880        ENDIF
14881      ENDIF
14882C
14883      RETURN
14884      END
14885      SUBROUTINE GRINDE
14886C
14887C     PURPOSE--INITIALIZE A SPECIFIC GRAPHICS DEVICE
14888C              TO DEFAULT POWER-ON CONDITIONS.
14889C
14890C     WRITTEN BY--JAMES J. FILLIBEN
14891C                 STATISTICAL ENGINEERING DIVISION
14892C                 INFORMATION TECHNOLOGY LABORATORY
14893C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
14894C                 GAITHERSBURG, MD 20899-8980
14895C                 PHONE--301-975-2855
14896C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
14897C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
14898C     LANGUAGE--ANSI FORTRAN (1977)
14899C     VERSION NUMBER--83.6
14900C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
14901C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
14902C                                      DRIVER OBSOLETE
14903C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
14904C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
14905C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
14906C                                      DRIVER OBSOLETE
14907C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
14908C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
14909C     UPDATED         --MAY      1989. CORRECT POSTSCRIPT SCALING (ALAN)
14910C     UPDATED         --MARCH    1990. ADD X11 DRIVER
14911C     UPDATED         --APRIL    1990. SUN PATCH (BILL ANDERSON)
14912C     UPDATED         --MAY      1990. ADD "SC" COMMAND TO HP-GL (ALAN)
14913C     UPDATED         --NOVEMBER 1990. POSTSCRIPT BUG FIX (BY ALAN HECKERT)
14914C     UPDATED         --JANUARY, 1991. REGIS (DEFINE MAX COLORS) (ALAN)
14915C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
14916C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
14917C                                      DRIVER OBSOLETE
14918C     UPDATED         --MAY      1991. INCREASE CHARACTER INDICES
14919C     UPDATED         --OCTOBER  1991. POSTSCRIPT UPDATES (ALAN)
14920C     UPDATED         --DECEMBER 1991. POSTSCRIPT BUG (ALAN)
14921C     UPDATED         --AUGUST   1992. CGM COLOR TABLE (ALAN)
14922C     UPDATED         --AUGUST   1992. HPGL FOR LASERJET III (ALAN)
14923C     UPDATED         --JANUARY  1993. FIX POSTSCRIPT HEADER (HAD
14924C                                      PROBLEM WITH FRAMEMAKER) (ALAN)
14925C     UPDATED         --MAY      1995. PASS MODEL NUMBER (WINDOW IDENT)
14926C                                      FOR X11 (USED BY FRONT-END)
14927C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
14928C                                      OLD CALCOMP STYLE
14929C                                      DRIVER OBSOLETE
14930C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
14931C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
14932C                                      USE BILL MITCHELLS OPENGL
14933C                                      BINDING FOR FORTRAN
14934C     UPDATED         --OCTOBER  1996. GKS (ALAN)
14935C                                      CODED, NOT TESTED
14936C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
14937C                                      PLACEHOLDER FOR NOW
14938C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
14939C                                      PLACEHOLDER FOR NOW
14940C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
14941C     UPDATED         --JULY     1998. WININTERACTOR CODE
14942C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
14943C     UPDATED         --JUNE     2000. MACINTOSH
14944C                                      PLACEHOLDER FOR NOW
14945C                     --MARCH    2002. CHANGE TO QUARTZ (NEW MAC GRAPHICS
14946C                                      LIBRARY)
14947C     UPDATED         --JUNE     2000. PC PRINTER
14948C                                      PLACEHOLDER FOR NOW
14949C                     --MARCH    2002. CHANGE TO GHOSTSCRIPT
14950C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
14951C                                      PLACEHOLDER FOR NOW
14952C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
14953C     UPDATED         --NOVEMBER 2002. SUPPORT FOR QWIN "-TILE" OPTION
14954C     UPDATED         --JANUARY  2003. SUPPORT FOR POSTSCRIPT SET
14955C                                      BOUNDING BOX OPTION
14956C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
14957C     UPDATED         --FEBRUARY 2006. IMPLEMENT THE LATEX DRIVER
14958C     UPDATED         --MARCH    2008. LAYER COUNTER FOR SVG
14959C     UPDATED         --MARCH    2008. PAGE COUNTER FOR POSTSCRIPT
14960C     UPDATED         --FEBRUARY 2009. ADD FOLLOWING PROCEDURES FOR
14961C                                      POSTSCRIPT
14962C                                      1) setpsfont
14963C                                      2) psstringwidthr
14964C                                      3) psstringwidthc
14965C                                      4) psstringwidthtv
14966C                                      5) psstringwidthcv
14967C                                      6) leftshow2
14968C                                      7) vleftshow2
14969C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
14970C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
14971C     UPDATED         --JULY     2015. FOR HEIGHT/WIDTH SETTINGS ON SVG
14972C                                      DEVICE, REMOVE LEADING SPACES
14973C                                      (CAUSED PROBLEM WITH KONQUEROR
14974C                                      BROWSER)
14975C     UPDATED         --OCTOBER  2015. CHECK IF QWIN DEVICE ALREADY OPEN
14976C     UPDATED         --NOVEMBER 2015. IDEVO3
14977C     UPDATED         --AUGUST   2016. FOR POSTSCRIPT, CHECK IF ERROR
14978C                                      DETECTED IN GRWRST CALL
14979C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
14980C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
14981C
14982C-----NON-COMMON VARIABLES (GRAPHICS)-----------------------------------
14983C
14984#ifdef HAVE_WININTERACTER
14985      USE WINTERACTER
14986      TYPE(WIN_STYLE)     :: WINDOW
14987#endif
14988#ifdef HAVE_INTERACTER
14989      USE INTERACTER
14990#endif
14991#ifdef HAVE_QWIN
14992CQWIN USE DFLIB
14993      USE IFQWIN
14994C
14995      LOGICAL MODESTATUS
14996      TYPE (WINDOWCONFIG)   DPSCREEN
14997      TYPE (QWINFO)  WINFO
14998      TYPE (FONTINFO) MSFONT
14999      CHARACTER*4 QWSCRN
15000      COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
15001CCCCC NOVEMBER 2002.  ADD FOLLOWING TWO LINES
15002      CHARACTER*4 IQWNTL
15003      COMMON/QUICKW4/IQWNTL
15004#endif
15005      COMMON/QUICKW5/IQWNFL
15006C
15007      CHARACTER*130 ICSTR
15008      CHARACTER*130 IATEMP
15009      CHARACTER*80 ISTEMP
15010      CHARACTER*4 ISUBN0
15011      CHARACTER*4 ISUBRO
15012      CHARACTER*4 IERROR
15013      CHARACTER*1 IQUOTE
15014      CHARACTER*1 ICARAT
15015      CHARACTER*2 ICJUNK
15016      CHARACTER*4 ICASE
15017      PARAMETER(MAXCLR=89)
15018      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
15019      CHARACTER*8 CTEMP
15020      CHARACTER*1 IA
15021      INTEGER IWIND(8)
15022C
15023C-----COMMON----------------------------------------------------------
15024C
15025      INCLUDE 'DPCOPA.INC'
15026      INCLUDE 'DPCOGR.INC'
15027      INCLUDE 'DPCONP.INC'
15028      INCLUDE 'DPCOBE.INC'
15029      INCLUDE 'DPCOST.INC'
15030      INCLUDE 'DPCODV.INC'
15031      INCLUDE 'DPCOF2.INC'
15032      CHARACTER*200 CMAPNM
15033      INTEGER RETNED,DD,CMAPSZ
15034#ifdef HAVE_SUN
15035      CHARACTER*200 SCNNAM,WINNAM,PTR
15036      INTEGER WINDFD,FLAGS,NOARGS
15037#endif
15038      INTEGER RD(8),GN(8),BE(8)
15039      INTEGER IADE(81)
15040      INTEGER IADE2(20)
15041CCCCC SOME DEVICES (SVG IN PARTICULAR) MAY NEED BACKGROUND COLOR
15042CCCCC AT INITIALIZATION.
15043C
15044      CHARACTER*4 IERASW
15045      CHARACTER*4 IBELSW
15046      CHARACTER*4 ISORSW
15047      CHARACTER*4 ICOPSW
15048      CHARACTER*4 IPENSW
15049      CHARACTER*4 IBACCO
15050      CHARACTER*4 IMARCO
15051      CHARACTER*4 IANISW
15052      CHARACTER*4 IDEFXC
15053      CHARACTER*4 IDEFBK
15054      CHARACTER*4 IDEFMC
15055      CHARACTER*4 IDEPEC
15056      CHARACTER*4 ISEQSW
15057      CHARACTER*4 IFENSW
15058      CHARACTER*4 INEGSW
15059      CHARACTER*4 IDEFMA
15060      CHARACTER*4 IDEFMO
15061      CHARACTER*4 IDEFM2
15062      CHARACTER*4 IDEFM3
15063      CHARACTER*4 IDEFPO
15064      CHARACTER*4 IDEFCN
15065      CHARACTER*4 IDEFDC
15066      CHARACTER*4 IDEFTU
15067      COMMON /CMISC/
15068     1IERASW,IBELSW,ISORSW,ICOPSW,
15069     1IPENSW,
15070     1IBACCO,IMARCO,IANISW,
15071     1IDEFXC,IDEFBK,IDEFMC,IDEPEC,
15072     1ISEQSW,
15073     1IFENSW,
15074     1INEGSW,
15075     1IDEFMA,IDEFMO,IDEFM2,IDEFM3,
15076     1IDEFPO,IDEFCN,IDEFDC,
15077     1IDEFTU
15078C
15079      CHARACTER*4 IPSTNW
15080      CHARACTER*4 IPSTN2
15081      COMMON/IPSTNW/IPSTNW,IPSTN2
15082C
15083#ifdef HAVE_GKS
15084      INTEGER ASF(13)
15085#endif
15086      INTEGER IGKSID
15087      INTEGER IGKSWK
15088      INTEGER IGKSTY
15089      COMMON/IGKS/IGKSID,IGKSWK,IGKSTY
15090C
15091CCCCC CHARACTER*80 IFILE1
15092      CHARACTER (LEN=MAXFNC) :: IFILE1
15093      CHARACTER*12 ISTAT1
15094      CHARACTER*12 IFORM1
15095      CHARACTER*12 IACCE1
15096      CHARACTER*12 IPROT1
15097      CHARACTER*12 ICURS1
15098      CHARACTER*4 IENDF1
15099      CHARACTER*4 IREWI1
15100      CHARACTER*4 IERRF1
15101C
15102      COMMON/GRAERR/IGFLAG
15103C
15104C-----COMMON VARIABLES (GENERAL)--------------------------------------
15105C
15106C  DEFINE RGB TABLES FOR CGM
15107C
15108      INCLUDE 'DPCOCT.INC'
15109      INCLUDE 'DPCOP2.INC'
15110C
15111#ifdef HAVE_GKS
15112      DATA ASF /13*1/
15113#endif
15114C
15115C-----START POINT-----------------------------------------------------
15116C
15117      ISUBN0='INDE'
15118      IERROR='NO'
15119      ISUBRO=' '
15120      IERRG4='NO'
15121C
15122      NCSTR=(-999)
15123C
15124      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'INDE')THEN
15125        WRITE(ICOUT,999)
15126  999   FORMAT(1X)
15127        CALL DPWRST('XXX','BUG ')
15128        WRITE(ICOUT,51)
15129   51   FORMAT('***** AT THE BEGINNING OF GRINDE--')
15130        CALL DPWRST('XXX','BUG ')
15131        WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3
15132   52   FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',3(A4,2X),A4)
15133        CALL DPWRST('XXX','BUG ')
15134        WRITE(ICOUT,54)IGUNIT,IGBAUD,IGCODE,ISOFT,ISOFT2,ISOFT3
15135   54   FORMAT('IGUNIT,IGBAUD,IGCODE,ISOFT,ISOFT2,ISOFT3 = ',
15136     1         2I8,4(2X,A4))
15137        CALL DPWRST('XXX','BUG ')
15138        WRITE(ICOUT,56)IBUGG4,ISUBG4,IERRG4,IOFFSV,IOFFSH
15139   56   FORMAT('IBUGG4,ISUBG4,IERRG4,IOFFSV,IOFFSH = ',4(A4,2X),A4)
15140        CALL DPWRST('XXX','BUG ')
15141      ENDIF
15142C
15143C               ********************************************
15144C               **  STEP 1--                              **
15145C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
15146C               **  AND THE MODEL                         **
15147C               ********************************************
15148C
15149      IF(IMANUF.EQ.'QWIN')THEN
15150        GOTO4700
15151      ELSEIF(IMANUF.EQ.'POST')THEN
15152        GOTO8600
15153      ELSEIF(IMANUF.EQ.'X11 ')THEN
15154        GOTO9600
15155      ELSEIF(IMANUF.EQ.'AQUA')THEN
15156        GOTO13500
15157      ELSEIF(IMANUF.EQ.'GENE')THEN
15158        IF(IMODEL.EQ.'CODE')GOTO3200
15159        IF(IMODEL.EQ.'CGM')GOTO3300
15160        IF(IMODEL.EQ.'CGMB')GOTO3400
15161        GOTO3100
15162      ELSEIF(IMANUF.EQ.'SVG ')THEN
15163        GOTO16000
15164      ELSEIF(IMANUF.EQ.'GD  ')THEN
15165        IF(IMODEL.EQ.'JPEG')GOTO12010
15166        IF(IMODEL.EQ.'PNG ')GOTO12020
15167        IF(IMODEL.EQ.'WBMP')GOTO12030
15168        IF(IMODEL.EQ.'GIF ')GOTO12040
15169        IF(IMODEL.EQ.'TIFF')GOTO12050
15170        IF(IMODEL.EQ.'BMP ')GOTO12060
15171        IF(IMODEL.EQ.'WEBP')GOTO12070
15172        IF(IMODEL.EQ.'TGA ')GOTO12080
15173        GOTO12000
15174      ELSEIF(IMANUF.EQ.'LATE')THEN
15175        GOTO15000
15176      ELSEIF(IMANUF.EQ.'CAIR')THEN
15177        GOTO17000
15178      ELSEIF(IMANUF.EQ.'D3  ')THEN
15179        GOTO19000
15180      ELSEIF(IMANUF.EQ.'WMF ')THEN
15181        GOTO18000
15182      ELSEIF(IMANUF.EQ.'OPGL')THEN
15183        GOTO4800
15184      ELSEIF(IMANUF.EQ.'TEKT')THEN
15185        IF(IMODEL.EQ.'4020')GOTO1100
15186        IF(IMODEL.EQ.'4022')GOTO1100
15187        IF(IMODEL.EQ.'4025')GOTO1100
15188        IF(IMODEL.EQ.'4027')GOTO1100
15189C
15190        IF(IMODEL.EQ.'4105')GOTO1200
15191        IF(IMODEL.EQ.'4107')GOTO1200
15192        IF(IMODEL.EQ.'4109')GOTO1200
15193        IF(IMODEL.EQ.'4115')GOTO1200
15194        IF(IMODEL.EQ.'4107')GOTO1200
15195        IF(IMODEL.EQ.'4113')GOTO1200
15196C
15197        GOTO9000
15198      ELSEIF(IMANUF.EQ.'HP')THEN
15199        IF(IMODEL.EQ.'7221')GOTO2100
15200        IF(IMODEL.EQ.'2622')GOTO2300
15201        IF(IMODEL.EQ.'2623')GOTO2300
15202        IF(IMODEL.EQ.'2627')GOTO2300
15203        IF(IMODEL.EQ.'2647')GOTO2300
15204        GOTO2200
15205      ELSEIF(IMANUF.EQ.'LIBP')THEN
15206        GOTO2600
15207      ELSEIF(IMANUF.EQ.'REGI')THEN
15208        GOTO8100
15209      ELSEIF(IMANUF.EQ.'GKS ')THEN
15210        GOTO11000
15211      ELSEIF(IMANUF.EQ.'LAHE')THEN
15212        IF(IMODEL.EQ.'INTE')GOTO4900
15213        IF(IMODEL.EQ.'WINT')GOTO4950
15214        GOTO4600
15215      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
15216        GOTO13000
15217      ELSEIF(IMANUF.EQ.'QUIC')THEN
15218        GOTO9100
15219      ELSEIF(IMANUF.EQ.'CALC')THEN
15220        GOTO4100
15221      ELSEIF(IMANUF.EQ.'ZETA')THEN
15222        GOTO5100
15223      ELSEIF(IMANUF.EQ.'TURB')THEN
15224        GOTO10000
15225      ELSEIF(IMANUF.EQ.'SUN ')THEN
15226        GOTO6600
15227      ENDIF
15228      GOTO9000
15229C
15230C               ***************************************************
15231C               **  STEP 11--                                    **
15232C               **  TREAT THE TEKTRONIX 4027 CASE--              **
15233C               **  (A COLOR TERMINAL).                          **
15234C               **  4. ENTER MONITOR AREA (SO CAN                **
15235C               **     COMMUNICATE WITH HOST)                    **
15236C               **     EXCLAMATION POINT MON K  (PAGE XXX)       **
15237C               **  2. DEFINE WORK AREA AS TOP 32 LINES          **
15238C               **     AND HAVE HOST OUTPUT TO TO WORK AREA      **
15239C               **     WHILE LEAVING KEYBOARD OUTPUT AS IS       **
15240C               **     EXCLAMATION POINT WOR 32 H  (PAGE XXX)    **
15241C               **  3. DEFINE DIALOGUE AREA AS TOP 32 LINES      **
15242C               **     OF WORK AREA (PLUS A BAD SIDE-EFFECT      **
15243C               **     OF MOVING CURSOR INTO DIALOGUE AREA       **
15244C               **     THERBY PROHIBITING FURTHER COMMIUNCITION  **
15245C               **     TO THE HOST SINCE CAN ONLY COMMUNICATE    **
15246C               **     WITH HOST IF IN MONITOR AREA.)            **
15247C               **     EXCLAMATION POINT GRA 1,32   (PAGE XXX)   **
15248C               **  4. RE-ENTER MONITOR AREA (SO CAN             **
15249C               **     COMMUNICATE WITH HOST)                    **
15250C               **     EXCLAMATION POINT MON K  (PAGE XXX)       **
15251C               ***************************************************
15252C
15253C     CORRECTIONS PROVIDED BY MARIA ZIMMER
15254C     WRIGHT-PATTERSON AFB, OHIO    JANUARY 1985
15255C
15256 1100 CONTINUE
15257      ICSTR(1:6)='!MON K'
15258      NCSTR=6
15259      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15260      ICSTR(1:9)='!WOR 32 H'
15261      NCSTR=9
15262      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15263      ICSTR(1:9)='!GRA 1,32'
15264      NCSTR=9
15265      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15266      ICSTR(1:6)='!MON K'
15267      NCSTR=6
15268      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15269      GOTO9000
15270C
15271C               *******************************************************
15272C               **  STEP 2--                                         **
15273C               **  TREAT THE TEKTRONIX 4105 CASE                    **
15274C               **  (A COLOR DEVICE)                                 **
15275C               **  1. ENABLE DIALOGUE AREA                          **
15276C               **     ESCAPE KA1   (PAGE 5-14)                      **
15277C               **  2. MAKE DIALOGUE AREA VISIBLE                    **
15278C               **     ESCAPE LV1      (PAGE 5-39)                   **
15279C               **  3. SET DIALOGUE AREA COLOR MAP--ESCAPE TF 4      **
15280C               **     INDEX HUE LIGHT                               **
15281C               **     ESCAPE TF40000                                **
15282C               **     ESCAPE TF410F40                               **
15283C               **     ESCAPE TF42G8C2F4                             **
15284C               **     ESCAPE TF43O0C2F4                             **
15285C               **     ESCAPE TF440C2F4                              **
15286C               **     ESCAPE TF45R<C2F4                             **
15287C               **     ESCAPE TF46C<C2F4                             **
15288C               **     ESCAPE TF47K4C2F4                             **
15289C               **     (PAGE 5-37 AND G-1)                           **
15290C               **  4. SET TEXT, TEXT CELL , AND BACKGROUND COLOR    **
15291C               **     FOR DIALOGUE                                  **
15292C               **     ESCAPE LI100  (PAGE 5-37)                     **
15293C               **   ESCAPE LZ      (PAGE 5-8)                       **
15294C               **  1. SET GRAPHICS AREA COLOR MAP                   **
15295C               **     ESCAPE TG140000                               **
15296C               **     ESCAPE TG1410F40                              **
15297C               **     ESCAPE TG142G8C2F4                            **
15298C               **     ESCAPE TG143O0C2F4                            **
15299C               **     ESCAPE TG1440C2F4                             **
15300C               **     ESCAPE TG145R<C2F4                            **
15301C               **     ESCAPE TG146C<C2F4                            **
15302C               **     ESCAPE TG147K4C2F4                            **
15303C               **     (PAGE 5-37 AND G-1)                           **
15304C               **  2. SET BACKGROUND COLOR FOR GRAPHICS             **
15305C               **     ESCAPE RA101     (PAGE 5-51)                  **
15306C               **  3. SET TEXT COLOR FOR GRAPHICS                   **
15307C               **     ESCAPE MT0     (PAGE 5-50)                    **
15308C               **  4. SET LINE & MARKER COLOR FOR GRAPHICS          **
15309C               **     ESCAPE ML1   (PAGE 5-45)                      **
15310C               **  5. SET LINE PATTERN (TO SOLID)                   **
15311C               **     ESCAPE SINGLE (LEFT TO RIGHT) QUOTE           **
15312C               **    (PAGE 5-52)                                    **
15313C               **  6. SET WINDOW TO (0,0) AND (4095,3132)           **
15314C               **     ESCAPE RW????     (PAGE 5-52 AND 98)          **
15315C               **  7. ERASE SCREEN                                  **
15316C               **     ESCAPE FORM-FEED                              **
15317C               ********************************************************
15318C
15319 1200 CONTINUE
15320      ICSTR(1:1)=IESCC
15321      ICSTR(2:4)='KA1'
15322      NCSTR=4
15323      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15324      ICSTR(1:1)=IESCC
15325      ICSTR(2:4)='LV1'
15326      NCSTR=4
15327      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15328      ICSTR(1:1)=IESCC
15329      ICSTR(2:8)='TF40000'
15330      NCSTR=8
15331      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15332      ICSTR(1:1)=IESCC
15333      ICSTR(2:9)='TF410F40'
15334      NCSTR=9
15335      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15336      ICSTR(1:1)=IESCC
15337      ICSTR(2:11)='TF42G8C2F4'
15338      NCSTR=11
15339      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15340      ICSTR(1:1)=IESCC
15341      ICSTR(2:11)='TF43O0C2F4'
15342      NCSTR=11
15343      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15344      ICSTR(1:1)=IESCC
15345      ICSTR(2:10)='TF440C2F4'
15346      NCSTR=10
15347      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15348      ICSTR(1:1)=IESCC
15349      ICSTR(2:11)='TF45R<C2F4'
15350      NCSTR=11
15351      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15352      ICSTR(1:1)=IESCC
15353      ICSTR(2:11)='TF46C<C2F4'
15354      NCSTR=11
15355      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15356      ICSTR(1:1)=IESCC
15357      ICSTR(2:11)='TF47K4C2F4'
15358      NCSTR=11
15359      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15360      ICSTR(1:1)=IESCC
15361      ICSTR(2:6)='LI100'
15362      NCSTR=6
15363      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15364      ICSTR(1:1)=IESCC
15365      ICSTR(2:9)='TG140000'
15366      NCSTR=9
15367      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15368      ICSTR(1:1)=IESCC
15369      ICSTR(2:10)='TG1410F40'
15370      NCSTR=10
15371      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15372      ICSTR(1:1)=IESCC
15373      ICSTR(2:12)='TG142G8C2F4'
15374      NCSTR=12
15375      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15376      ICSTR(1:1)=IESCC
15377      ICSTR(2:12)='TG143O0C2F4'
15378      NCSTR=12
15379      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15380      ICSTR(1:1)=IESCC
15381      ICSTR(2:11)='TG1440C2F4'
15382      NCSTR=11
15383      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15384      ICSTR(1:1)=IESCC
15385      ICSTR(2:12)='TG145R<C2F4'
15386      NCSTR=12
15387      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15388      ICSTR(1:1)=IESCC
15389      ICSTR(2:12)='TG146C<C2F4'
15390      NCSTR=12
15391      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15392      ICSTR(1:1)=IESCC
15393      ICSTR(2:12)='TG147K4C2F4'
15394      NCSTR=12
15395      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15396      ICSTR(1:1)=IESCC
15397      ICSTR(2:6)='RA101'
15398      NCSTR=6
15399      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15400      ICSTR(1:1)=IESCC
15401      ICSTR(2:4)='MT0'
15402      NCSTR=4
15403      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15404      ICSTR(1:1)=IESCC
15405      ICSTR(2:4)='ML1'
15406      NCSTR=4
15407      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15408      ICSTR(1:1)=IESCC
15409      ICSTR(2:2)=IFFC
15410      NCSTR=2
15411      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15412      GOTO9000
15413C
15414C               ****************************************************
15415C               **  STEP 21--                                     **
15416C               **  TREAT THE HEWLETT-PACKARD 7221 CASE           **
15417C               **  (MULTI-COLOR PENPLOTTER)                      **
15418C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER          **
15419C               **             OPERATING AND PROGRAMMING MANUAL,  **
15420C               **             PAGE XX.                           **
15421C               ****************************************************
15422C
15423 2100 CONTINUE
15424      CALL GROPDE
15425      ICSTR(1:1)='+'
15426      ICSTR(2:2)=IESCC
15427      ICSTR(3:5)='.K}'
15428      NCSTR=5
15429      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15430      CALL GRCLDE
15431      GOTO9000
15432C
15433C               ******************************************************
15434C               **  STEP 22--                                       **
15435C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
15436C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
15437C               **  (MULTI-COLOR PENPLOTTERS)                       **
15438C               **  TO INITIALIZE DEVICE--                          **
15439C               **  SEND    IN                                      **
15440C               **  (WITH A TRAILING SEMI-COLON WHICH IS THE        **
15441C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
15442C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
15443C               **             OPERATING AND PROGRAMMING MANUAL,    **
15444C               **             PAGE 40, 141.                        **
15445C               **  ALLOW GRAPH LIMITS ON THE PLOTTER TO            **
15446C               **  TAKE ON HARDWARE DEFAULT                        **
15447C               **  (X = 520 TO 15720 MACHINE UNITS                 **
15448C               **  AND Y = 380 TO 10380 MACHINE UNITS).            **
15449C               **  BY PURPOSELY NOT SETTING THE GRAPH LIMITS,      **
15450C               **  THIS WILL ALLOW THE USER TO MANUALLY            **
15451C               **  CHANGE LIMITS BY THE PLOTTER BUTTONS            **
15452C               **  SO AS TO ACCOMODATE DIFFERENT SIZE PAPER.       **
15453C               **  ALSO ALLOW THE PLOTTER UNITS                    **
15454C               **  (= PLOTTER "RESOLUTION") TO                     **
15455C               **  TAKE ON THE HARDWARE DEFAULT WHICH IS           **
15456C               **  3040 UNITS IN THE X DIRECTION AND               **
15457C               **  2000 UNITS IN THE Y DIRECTION                   **
15458C               ******************************************************
15459C
15460 2200 CONTINUE
15461C
15462C     THE FOLLOWING WAS COMMENTED OUT
15463C     ON THE SUGGESTION OF PETER VERDIER (DEC., 1984)
15464C
15465CCCCC ICSTR(1:3)='IN;'
15466CCCCC NCSTR=3
15467CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15468CCCCC AUGUST 1992.  FOLLOWING LINES ADDED FOR LASER JET III
15469      IF(IMODE3.EQ.'LJET')THEN
15470        ICSTR(1:1)=IESCC
15471        ICSTR(2:2)='E'
15472        NCSTR=2
15473        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15474        ICSTR(2:4)='%0B'
15475        NCSTR=4
15476        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15477        ICSTR(1:3)='IN;'
15478        NCSTR=3
15479        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15480        ICSTR(1:4)='RO90'
15481        NCSTR=4
15482        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15483      ENDIF
15484      ICSTR(1:2)='SC'
15485      NCSTR=2
15486      NCHTOT=5
15487      IXMIN=0
15488      IXMAX=IHPGX
15489      IYMIN=0
15490      IYMAX=IHPGY
15491      CALL GRTRIN(IXMIN,NCHTOT,ICSTR,NCSTR)
15492      NCSTR=NCSTR+1
15493      ICSTR(NCSTR:NCSTR)=','
15494      CALL GRTRIN(IXMAX,NCHTOT,ICSTR,NCSTR)
15495      NCSTR=NCSTR+1
15496      ICSTR(NCSTR:NCSTR)=','
15497      CALL GRTRIN(IYMIN,NCHTOT,ICSTR,NCSTR)
15498      NCSTR=NCSTR+1
15499      ICSTR(NCSTR:NCSTR)=','
15500      CALL GRTRIN(IYMAX,NCHTOT,ICSTR,NCSTR)
15501      NCSTR=NCSTR+1
15502      ICSTR(NCSTR:NCSTR)=';'
15503      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15504      GOTO9000
15505C
15506C               **********************************************************
15507C               **  STEP 23--                                           **
15508C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
15509C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
15510C               **  (MONOCHROME DISPLAY TERMINALS)                      **
15511C               **  TO INITIATE DEVICE--
15512C               **     STEP 1--TURN GRAPHICS DISPLAY ON
15513C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
15514C               **             REFERENCE MANUAL,                        **
15515C               **             PAGE 10-4, XXX.                          **
15516C               **********************************************************
15517C
15518 2300 CONTINUE
15519      ICSTR(1:1)=IESCC
15520      ICSTR(2:5)='*dcZ'
15521      NCSTR=5
15522      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15523      GOTO9000
15524C
15525C               **********************************************************
15526C               **  STEP 26--                                           **
15527C               **  TREAT THE UNIX LIBPLOT                    CASE      **
15528C               **********************************************************
15529C
15530 2600 CONTINUE
15531      ITYPE=10
15532      IF(IMODEL.EQ.'X')ITYPE=1
15533      IF(IMODEL.EQ.'PNM')ITYPE=2
15534      IF(IMODEL.EQ.'PNM ' .AND. IMODE2.EQ.'ASCI')ITYPE=14
15535      IF(IMODEL.EQ.'GIF')ITYPE=3
15536      IF(IMODEL.EQ.'AI')ITYPE=4
15537      IF(IMODEL.EQ.'PS')ITYPE=5
15538      IF(IMODEL.EQ.'POST')ITYPE=5
15539      IF(IMODEL.EQ.'FIG')ITYPE=6
15540      IF(IMODEL.EQ.'XFIG')ITYPE=6
15541      IF(IMODEL.EQ.'PCL')ITYPE=7
15542      IF(IMODEL.EQ.'HPGL')ITYPE=8
15543      IF(IMODEL.EQ.'TEKT')ITYPE=9
15544      IF(IMODEL.EQ.'TEKT' .AND. IMODE2.EQ.'FILE')ITYPE=19
15545      IF(IMODEL.EQ.'META')ITYPE=10
15546      IF(IMODEL.EQ.'META' .AND. IMODE2.EQ.'ASCI')ITYPE=13
15547      IF(IMODEL.EQ.'SVG')ITYPE=11
15548      IF(IMODEL.EQ.'PNG')ITYPE=12
15549      IF(IMODEL.EQ.'REGI')ITYPE=15
15550      IF(IMODEL.EQ.'REGI' .AND. IMODE2.EQ.'FILE')ITYPE=16
15551      IF(IMODEL.EQ.'CGM')ITYPE=17
15552      IF(IMODEL.EQ.'CGM' .AND. IMODE2.EQ.'ASCI')ITYPE=18
15553      IERR=0
15554C
15555      DO2601I=1,20
15556        IADE(I)=0
15557        IADE2(I)=0
15558 2601 CONTINUE
15559      IF(IX11DN.EQ.'DEFAULT')THEN
15560        IADE(1)=0
15561      ELSE
15562        DO2610I=20,1,-1
15563          ILAST=I
15564          IF(IX11DN(I:I).NE.' ')GOTO2619
15565 2610   CONTINUE
15566        ILAST=0
15567 2619   CONTINUE
15568        IF(ILAST.GT.0)THEN
15569          DO2620I=1,ILAST
15570            CALL DPCOAN(IX11DN(I:I),IJUNK)
15571            IADE(I)=IJUNK
15572 2620     CONTINUE
15573        ENDIF
15574        IADE(ILAST+1)=0
15575      ENDIF
15576C
15577      IXSIZE=ILPLXS
15578      IYSIZE=ILPLYS
15579      NCHAR=0
15580      IF(IXSIZE.LE.999)THEN
15581        NCHAR=NCHAR+1
15582        WRITE(ISTEMP(NCHAR:NCHAR+2),'(I3)')IXSIZE
15583        NCHAR=NCHAR+2
15584      ELSEIF(IXSIZE.LE.9999)THEN
15585        NCHAR=NCHAR+1
15586        WRITE(ISTEMP(NCHAR:NCHAR+3),'(I4)')IXSIZE
15587        NCHAR=NCHAR+3
15588      ELSE
15589        NCHAR=NCHAR+1
15590        WRITE(ISTEMP(NCHAR:NCHAR+4),'(I5)')IXSIZE
15591        NCHAR=NCHAR+4
15592      ENDIF
15593      NCHAR=NCHAR+1
15594      ISTEMP(NCHAR:NCHAR)='x'
15595      IF(IYSIZE.LE.999)THEN
15596        NCHAR=NCHAR+1
15597        WRITE(ISTEMP(NCHAR:NCHAR+2),'(I3)')IYSIZE
15598        NCHAR=NCHAR+2
15599      ELSEIF(IXSIZE.LE.9999)THEN
15600        NCHAR=NCHAR+1
15601        WRITE(ISTEMP(NCHAR:NCHAR+3),'(I4)')IYSIZE
15602        NCHAR=NCHAR+3
15603      ELSE
15604        NCHAR=NCHAR+1
15605        WRITE(ISTEMP(NCHAR:NCHAR+4),'(I5)')IYSIZE
15606        NCHAR=NCHAR+4
15607      ENDIF
15608C
15609      DO2660I=NCHAR,1,-1
15610        ILAST=I
15611        IF(ISTEMP(I:I).NE.' ')GOTO2669
15612 2660 CONTINUE
15613 2669 CONTINUE
15614      DO2670I=1,ILAST
15615        CALL DPCOAN(ISTEMP(I:I),IJUNK)
15616        IADE2(I)=IJUNK
15617 2670 CONTINUE
15618      IADE2(ILAST+1)=0
15619C
15620#ifdef HAVE_LIBPLOT
15621      CALL PLINIT(ITYPE,IERR,IADE2,DBLE(PLPLRO),IADE)
15622#endif
15623C
15624      IF(IERR.EQ.1)THEN
15625        WRITE(ICOUT,2671)
15626 2671   FORMAT('***** ERROR FROM LIBPLOT DEVICE--')
15627        CALL DPWRST('XXX','BUG ')
15628        WRITE(ICOUT,2673)
15629 2673   FORMAT('      ERROR OCCURED IN CALL TO  pl_newpl  ROUTINE.')
15630        CALL DPWRST('XXX','BUG ')
15631      ELSEIF(IERR.EQ.2)THEN
15632        WRITE(ICOUT,2671)
15633        CALL DPWRST('XXX','BUG ')
15634        WRITE(ICOUT,2678)
15635 2678   FORMAT('      ERROR OCCURED IN CALL TO  pl_selectpl  ROUTINE.')
15636        CALL DPWRST('XXX','BUG ')
15637      ENDIF
15638C
15639      GOTO9000
15640C
15641C               ***************************************************
15642C               **  STEP 31--                                    **
15643C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE  **
15644C               ***************************************************
15645C
15646 3100 CONTINUE
15647      ICSTR(1:17)='INITIALIZE DEVICE'
15648      NCSTR=17
15649      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15650      GOTO9000
15651C
15652C               ***************************************************************
15653C               **  STEP 32--                                                **
15654C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
15655C               ***************************************************************
15656C
15657 3200 CONTINUE
15658      ICSTR(1:4)='INDE'
15659      NCSTR=4
15660      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15661      GOTO9000
15662C
15663C               ***************************************************
15664C               **  STEP 33--                                    **
15665C               **  TREAT THE CGM     (DEVICE-INDEPENDENT) CASE  **
15666C               ***************************************************
15667C
15668C     AUGUST 1992.  DEFINE COLOR TABLE (CURRENTLY SUPPORT 67 COLORS
15669C                   IN CGM).
15670C
15671 3300 CONTINUE
15672      CALL DPCONA(39,IQUOTE)
15673      ICSTR(1:6)='BEGMF '
15674      ICSTR(7:7)=IQUOTE
15675      ICSTR(8:24)='DATAPLOT CGM FILE'
15676      ICSTR(25:25)=IQUOTE
15677      ICSTR(26:26)=';'
15678      NCSTR=26
15679      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15680      ICSTR(1:18)='MFVERSION 1;'
15681      NCSTR=12
15682      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15683      ICSTR(1:7)='MFDESC '
15684      ICSTR(8:8)=IQUOTE
15685      ICSTR(9:21)='AUGUST,  1992'
15686      ICSTR(22:22)=IQUOTE
15687      ICSTR(23:23)=';'
15688      NCSTR=23
15689      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15690      ICSTR(1:11)='MFELEMLIST '
15691      ICSTR(12:12)=IQUOTE
15692      ICSTR(13:23)='DRAWINGPLUS'
15693      ICSTR(24:24)=IQUOTE
15694      ICSTR(25:25)=';'
15695      NCSTR=25
15696      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15697      ICSTR(1:13)='VDCTYPE REAL;'
15698      NCSTR=13
15699      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15700C
15701C     AUGUST 1992.  COMMENT OUT FOLLOWING 6 LINES.  NOW ALLOW FOR
15702C                   FULL SET OF 67 DATAPLOT COLORS.  DEFINE THE COLOR MAP.
15703CCCCC ICSTR(1:16)='COLRINDEXPREC 8;'
15704CCCCC NCSTR=16
15705CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15706CCCCC ICSTR(1:15)='MAXCOLRINDEX 8;'
15707CCCCC NCSTR=15
15708CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15709      ICSTR(1:18)='COLRINDEXPREC 255;'
15710      NCSTR=18
15711      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15712      ICSTR(1:13)='MAXCOLRINDEX '
15713      NCSTR=13
15714      NCHTOT=3
15715      CALL GRTRIN(MAXCLR,NCHTOT,ICSTR,NCSTR)
15716      NCSTR=NCSTR+1
15717      ICSTR(NCSTR:NCSTR)=';'
15718      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15719      ICSTR(1:10)='COLRTABLE '
15720      NCHTOT=3
15721      DO3310I=1,MAXCLR
15722        NCSTR=10
15723        IVAL=I
15724        CALL GRTRIN(IVAL,NCHTOT,ICSTR,NCSTR)
15725        NCSTR=NCSTR+1
15726        ICSTR(NCSTR:NCSTR)=' '
15727        IVAL=IRED(I)
15728        CALL GRTRIN(IVAL,NCHTOT,ICSTR,NCSTR)
15729        NCSTR=NCSTR+1
15730        ICSTR(NCSTR:NCSTR)=' '
15731        IVAL=IGREEN(I)
15732        CALL GRTRIN(IVAL,NCHTOT,ICSTR,NCSTR)
15733        NCSTR=NCSTR+1
15734        ICSTR(NCSTR:NCSTR)=' '
15735        IVAL=IBLUE(I)
15736        CALL GRTRIN(IVAL,NCHTOT,ICSTR,NCSTR)
15737        NCSTR=NCSTR+1
15738        ICSTR(NCSTR:NCSTR)=';'
15739        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15740 3310 CONTINUE
15741C      END CHANGE
15742      ICSTR(1:9)='FONTLIST '
15743      ICSTR(10:10)=IQUOTE
15744      ICSTR(11:24)='HARDWARE      '
15745      ICSTR(25:25)=IQUOTE
15746      ICSTR(26:26)=','
15747      NCSTR=26
15748      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15749      ICSTR(1:9)='         '
15750      ICSTR(11:24)='SIMPLEX       '
15751      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15752      ICSTR(11:24)='DUPLEX        '
15753      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15754      ICSTR(11:24)='TRIPLEX       '
15755      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15756      ICSTR(11:24)='COMPLEX       '
15757      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15758      ICSTR(11:24)='TRIPLEX ITALIC'
15759      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15760      ICSTR(11:24)='SIMPLEX SCRIPT'
15761      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15762      ICSTR(11:24)='COMPLEX SCRIPT'
15763      ICSTR(26:26)=';'
15764      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15765      ICSTR(1:14)='BEGMFDEFAULTS;'
15766      NCSTR=14
15767      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15768      ICSTR(1:30)='VDCEXT 0.0, 0.0, 100.0, 100.0;'
15769      NCSTR=30
15770      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15771      ICSTR(1:17)='COLRMODE INDEXED;'
15772      NCSTR=17
15773      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15774      ICSTR(1:21)='LINEWIDTHMODE SCALED;'
15775      NCSTR=21
15776      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15777      ICSTR(1:14)='ENDMFDEFAULTS;'
15778      NCSTR=14
15779      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
15780      GOTO9000
15781C
15782C               ***************************************************
15783C               **  STEP 34--                                    **
15784C               **  TREAT THE CGM (BINARY)                 CASE  **
15785C               ***************************************************
15786C
15787 3400 CONTINUE
15788      GOTO9000
15789C
15790C               ******************************************************
15791C               **  STEP 41--                                       **
15792C               **  TREAT THE CALCOMP XXXXXX CASE                   **
15793C               **  USE CALCOMP LIBRARY ROUTINE                     **
15794C               **  ROUTINE PLOTS INITIALIZES PLOTTER               **
15795C               ******************************************************
15796C
15797 4100 CONTINUE
15798      IUNIT=IGUNIT
15799      REWIND(IUNIT)
15800      IREL=53
15801      IDUM=0
15802#ifdef HAVE_CALCOMP
15803      CALL PLOTS(IREL,IDUM,IUNIT)
15804#endif
15805      GOTO9000
15806C
15807C               ******************************************************
15808C               **  STEP 46--                                       **
15809C               **  TREAT THE LAHEY   XXXXXX CASE                   **
15810C               **  REFERENCE--Programmer's Reference, Revision C   **
15811C               **             Lahey Computer Systems, January, 1992**
15812C               **             PAGES 51 THRU 65                     **
15813C               ******************************************************
15814C
15815C     DO NOT SWITCH TO GRAPHICS MODE UNTIL DO A SCREEN ERASE IN
15816C     GRERSC ROUTINE.  NORMAL ALPHANUMERIC DOES NOT WORK WELL IN
15817C     GRAPHICS MODE, SO LEAVE TERMINAL IN TEXT MODE AS LONG AS POSSIBLE.
15818C
15819 4600 CONTINUE
15820      ILAHSW='OFF'
15821      GOTO9000
15822C
15823C               ******************************************************
15824C               **  STEP 47--                                       **
15825C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
15826C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
15827C               ******************************************************
15828C
15829 4700 CONTINUE
15830C
15831      IF(IQWNFL.EQ.1)THEN
15832        WRITE(ICOUT,4711)
15833 4711   FORMAT('***** WARNING FROM QUICKWIN DEVICE--')
15834        CALL DPWRST('XXX','BUG ')
15835        WRITE(ICOUT,4713)
15836 4713   FORMAT('      QUCIKWIN DEVICE APPEARS TO BE OPEN, ',
15837     1         'NOTHING DONE.')
15838        CALL DPWRST('XXX','BUG ')
15839        GOTO9000
15840      ENDIF
15841C
15842      IQWNFL=1
15843C
15844#ifdef HAVE_QWIN
15845CCCCC SPECIFY DESIRED DIMENSIONS AS MODEL (I.E., DEVICE 1 QWIN 400 300)
15846      IF(IMODEL.EQ.'DYNA')THEN
15847        AJUNK1=-1.
15848        AJUNK2=-1.
15849      ELSEIF(IMODEL.NE.' ' .AND. IMODE2.NE.' ')THEN
15850        READ(IMODEL(1:4),'(I4.4)',ERR=4701)ITEMP1
15851        READ(IMODEL(1:4),'(I4.4)',ERR=4701)ITEMP2
15852        IF(ITEMP1.GE.100 .AND.ITEMP1.LE.1000)AJUNK1=REAL(ITEMP1)
15853        IF(ITEMP2.GE.100 .AND.ITEMP2.LE.1000)AJUNK2=REAL(ITEMP2)
15854      ELSE
15855        IF(QWSCRN.EQ.'VGA')THEN
15856          AJUNK1=400.
15857          AJUNK2=300.
15858        ELSEIF(QWSCRN.EQ.'SVGA')THEN
15859          AJUNK1=600.
15860          AJUNK2=450.
15861        ELSEIF(QWSCRN.EQ.'LARG')THEN
15862          AJUNK1=700.
15863          AJUNK2=550.
15864        ELSEIF(QWSCRN.EQ.'LAPTOP')THEN
15865          AJUNK1=700.
15866          AJUNK2=450.
15867        ELSEIF(QWSCRN.EQ.'JJF')THEN
15868          AJUNK1=550.
15869          AJUNK2=500.
15870        ELSEIF(QWSCRN.EQ.'WIDE')THEN
15871          AJUNK1=900.
15872          AJUNK2=675.
15873        ELSEIF(QWSCRN.EQ.'LARG')THEN
15874          AJUNK1=700.
15875          AJUNK2=550.
15876        ELSE
15877          AJUNK1=600.
15878          AJUNK2=450.
15879        ENDIF
15880      ENDIF
15881 4701 CONTINUE
15882      DPSCREEN.NUMXPIXELS=-1
15883      DPSCREEN.NUMYPIXELS=-1
15884      DPSCREEN.NUMTEXTCOLS=-1
15885      DPSCREEN.NUMTEXTROWS=-1
15886      DPSCREEN.NUMCOLORS=-1
15887      DPSCREEN.FONTSIZE=-1
15888      DPSCREEN.TITLE="Dataplot Graphics"
15889      OPEN(UNIT=99,FILE='USER',TITLE='Dataplot Graphics',
15890     1IOFOCUS=.TRUE.)
15891C
15892      IF(AJUNK1.LT.0.)GOTO9000
15893      IRESLT=INITIALIZEFONTS()
15894      IRESLT=SETFONT('fh16w8b')
15895      MODESTATUS=GETFONTINFO(MSFONT)
15896      ICHRHT=MSFONT.PIXHEIGHT
15897      ICHRWD=MSFONT.PIXWIDTH
15898      IF(ICHRWD.EQ.0)ICHRWD=MSFONT.AVGWIDTH
15899      IF(ICHRWD.EQ.0)ICHRWD=ICHRHT/2
15900      MODESTATUS=SETWINDOWCONFIG(DPSCREEN)
15901      IF(.NOT. MODESTATUS) MODESTATUS=SETWINDOWCONFIG(DPSCREEN)
15902      ISTATUS=DISPLAYCURSOR($GCURSORON)
15903      MODESTATUS=GETWINDOWCONFIG(DPSCREEN)
15904      IRESLT=GETWSIZEQQ(QWIN$FRAMEWINDOW,QWIN$SIZECURR,WINFO)
15905      AJUNK3=REAL(WINFO.W)
15906      AJUNK4=REAL(WINFO.H)
15907C
15908      WINFO.TYPE=QWIN$SET
15909      WINFO.W=50
15910      WINFO.H=20
15911      WINFO.X=10
15912      WINFO.Y=2
15913      IF(ICHRWD.GT.0)THEN
15914        WINFO.W=INT(AJUNK1/REAL(ICHRWD)+0.5)
15915        WINFO.X=MAX(INT((AJUNK3-AJUNK1)/REAL(ICHRWD)+0.5)-3,10)
15916      ENDIF
15917      IF(ICHRHT.GT.0)THEN
15918        WINFO.H=INT(AJUNK2/REAL(ICHRHT)+0.5)
15919        WINFO.Y=MAX(INT((AJUNK4-AJUNK2)/REAL(ICHRHT)+0.5)-3,2)
15920      ENDIF
15921      IRESLT=SETWSIZEQQ(99,WINFO)
15922      IRESLT=GETWSIZEQQ(99,QWIN$SIZECURR,WINFO)
15923C
15924      NUMHPP=WINFO.W*ICHRWD
15925      NUMVPP=WINFO.H*ICHRHT
15926      ANUMHP=REAL(NUMHPP)
15927      ANUMVP=REAL(NUMVPP)
15928      IRESLT=FOCUSQQ(IPR)
15929      ISTATUS=DISPLAYCURSOR($GCURSORON)
15930CCCCC FOLLOWING CODE ADDED 7/98  (TO ALLOW USER TO SET
15931CCCCC BACKGROUND AND FOREGROUND COLORS FOR TEXT WINDOW)
15932CCCCC MAKE DISTINCTION BETWEEN DIRECT COLOR AND VGA COLOR MODES!
15933      IF(IQWNCL.EQ.'VGA')THEN
15934        IF(IQWNBC.LT.0)IQWNBC=0
15935        IF(IQWNBC.GT.15)IQWNBC=15
15936        IF(IQWNF2.LT.0)IQWNF2=0
15937        IF(IQWNF2.GT.15)IQWNF2=15
15938        IF(IQWNBC.NE.0 .OR. IQWNF2.NE.15)THEN
15939          IRESLT=SETACTIVEQQ(IPR)
15940CQWIN     IRESLT=SETBKCOLOR(INT2(IQWNBC))
15941          IRESLT=SETBKCOLOR(IQWNBC)
15942          IRESLT=SETTEXTCOLOR(INT2(IQWNF2))
15943CCCCC     CALL CLEARSCREEN($GCLEARSCREEN)
15944          IRESLT=SETACTIVEQQ(99)
15945        ENDIF
15946      ELSEIF(IQWNCL.EQ.'RGB')THEN
15947        IRESLT=SETACTIVEQQ(IPR)
15948        IF(IQWNBC.LT.0.OR.IQWNBC.GT.88)IQWNBC=0
15949        IF(IQWNF2.LT.0.OR.IQWNF2.GT.88)IQWNF2=1
15950        IF(IQWNBC.GE.0)THEN
15951          JTEMP=IQWNBC+1
15952          JTEMP2=RGBTOINTEGER(IRED(JTEMP),IGREEN(JTEMP),IBLUE(JTEMP))
15953          ISTATUS=SETBKCOLORRGB(JTEMP2)
15954        ENDIF
15955        JTEMP=IQWNF2+1
15956        JTEMP2=RGBTOINTEGER(IRED(JTEMP),IGREEN(JTEMP),IBLUE(JTEMP))
15957        ISTATUS=SETTEXTCOLORRGB(JTEMP2)
15958        ISTATUS=SETCOLORRGB(JTEMP2)
15959CCCCC   CALL CLEARSCREEN($GCLEARSCREEN)
15960        ISTATUS=DISPLAYCURSOR($GCURSORON)
15961        IRESLT=SETACTIVEQQ(99)
15962      ENDIF
15963C
15964CCCCC NOVEMBER 2002.  SUPPORT FOR "-TILE" OPTION.
15965C
15966      IF(IQWNTL.EQ.'ON')THEN
15967        IRESLT=CLICKMENUQQ(QWIN$TILE)
15968      ENDIF
15969#endif
15970      GOTO9000
15971C
15972C               ******************************************************
15973C               **  STEP 48--                                       **
15974C               **  TREAT THE OPEN-GL DRIVER                        **
15975C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
15976C               ******************************************************
15977C
15978 4800 CONTINUE
15979      IF(IORNSW.EQ.'LAND')THEN
15980        IORIEN=0
15981      ELSE IF(IORNSW.EQ.'PORT')THEN
15982        IORIEN=1
15983      ELSE IF(IORNSW.EQ.'SQUA')THEN
15984        IORIEN=3
15985      ELSE
15986        IORIEN=2
15987      END IF
15988C
15989      DO4810I=20,1,-1
15990        ILAST=I
15991        IF(IX11DN(I:I).NE.' ')GOTO4819
15992 4810 CONTINUE
15993 4819 CONTINUE
15994      DO4820I=1,ILAST
15995        CALL DPCOAN(IX11DN(I:I),IJUNK)
15996        IADE(I)=IJUNK
15997 4820 CONTINUE
15998      IADE(ILAST+1)=0
15999C
16000      DO4829I=1,8
16001      IWIND(I)=-1
16002 4829 CONTINUE
16003      ICOUNT=0
16004      IF(IMODEL.EQ.'    '.AND.IMODE2.EQ.'    ')GOTO4839
16005      CTEMP(1:4)=IMODEL(1:4)
16006      CTEMP(5:8)=IMODE2(1:4)
16007      ICOUNT=0
16008      DO4830I=8,1,-1
16009        IA=CTEMP(I:I)
16010        IF(IA.EQ.' ')GOTO4830
16011        ICOUNT=ICOUNT+1
16012        CALL DPCOAN(IA,IVALUE)
16013        IF(IVALUE.GE.48.AND.IVALUE.LE.57)THEN
16014          IWIND(ICOUNT)=IVALUE-48
16015        ELSEIF(IVALUE.GE.65.AND.IVALUE.LE.70)THEN
16016          IWIND(ICOUNT)=IVALUE-55
16017        ELSEIF(IVALUE.GE.97.AND.IVALUE.LE.102)THEN
16018          IWIND(ICOUNT)=IVALUE-87
16019        ELSE
16020          ICOUNT=1
16021          WRITE(ICOUT,4833)
16022          GOTO4839
16023        ENDIF
16024 4830 CONTINUE
16025 4833 FORMAT('***** WARNING--INVALID WINDOW ID FROM FRONT-END.  ',
16026     1'A SEPARATE GRAPHICS WINDOW WILL BE OPENED.')
16027 4839 CONTINUE
16028      IERRNO=0
16029      IXPIX=0
16030      IYPIX=0
16031#ifdef HAVE_GL
16032      CALL GLINIT(IXTEMP,IYTEMP,IORIEN,IXPIX,IYPIX,IADE,IWIND,ICOUNT,
16033     1            IERRNO)
16034#endif
16035      IF(IERRNO.EQ.1) THEN
16036         WRITE(ICOUT,4851)
16037 4851    FORMAT('CANNOT OPEN X11 WINDOW.')
16038         CALL DPWRST('XXX','BUG ')
16039         IX11OF='OFF'
16040      ELSE
16041         IX11OF='ON'
16042         ANUMHP=REAL(IXPIX)
16043         ANUMVP=REAL(IYPIX)
16044      ENDIF
16045      GOTO9000
16046C
16047C               ******************************************************
16048C               **  STEP 49--                                       **
16049C               **  TREAT THE LAHEY INTERACTOR CASE                 **
16050C               ******************************************************
16051C
16052 4900 CONTINUE
16053#ifdef HAVE_INTERACTER
16054      CALL IScreenOpen(' ','GW',800,600,16)
16055      CALL IScreenTitle('G','Dataplot')
16056      CALL IScreenInit(' ')
16057#endif
16058      GOTO9000
16059C
16060C               ******************************************************
16061C               **  STEP 49B-                                       **
16062C               **  TREAT THE LAHEY WINTERACTOR CASE                **
16063C               ******************************************************
16064C
16065 4950 CONTINUE
16066#ifdef HAVE_WININTERACTER
16067      IHAND1=0
16068      IHAND2=1
16069      CALL WInitialise(' ')
16070      ISCRWID=WInfoScreen(1)
16071      ISCRHGT=WInfoScreen(2)
16072      ISCCOL=WInfoScreen(3)
16073      WINDOW%FLAGS=SysMenuOn + MinButton + MaxButton
16074      WINDOW%X=ISCRWID - (IWINHP + 10)
16075      WINDOW%Y=(ISCRHGT - IWINVP) - 50
16076      WINDOW%WIDTH=IWINHP
16077      WINDOW%HEIGHT=IWINVP
16078      IDR_MENU1=30001
16079      WINDOW%MENUID=IDR_MENU1
16080      WINDOW%TITLE='Dataplot Graphics'
16081CCCCC CALL WindowOpenChild(WINDOW,IHAND2)
16082      CALL WindowOpen(WINDOW)
16083      CALL WindowSelect(IHAND1)
16084C
16085      IXPIX=WInfoWindow(1)
16086      IYPIX=WInfoWindow(2)
16087CCCCC ANUMHP=REAL(IXPIX)
16088CCCCC ANUMVP=REAL(IYPIX)
16089      IF(IWINCL.EQ.'RGB')THEN
16090        CALL IGrPaletteInit()
16091        JCOL=1
16092        CALL IGrPaletteRGB(0,IRED(JCOL),IGREEN(JCOL),IBLUE(JCOL))
16093        IERRO2=InfoError(1)
16094        ISTAT2=InfoError(2)
16095        DO4960I=1,MAXCLR
16096          IINDEX=I
16097          CALL IGrPaletteRGB(IINDEX,IRED(IINDEX),IGREEN(IINDEX),
16098     1                       IBLUE(IINDEX))
16099          IERRO2=InfoError(1)
16100          ISTAT2=InfoError(2)
16101          IF(IERRO2.EQ.1 .OR. IERRO2.EQ.2)THEN
16102            WRITE(ICOUT,4969) IINDEX
16103 4969       FORMAT('*****LAHEY: ERROR LOADING COLOR INDEX ',I8)
16104            CALL DPWRST('XXX','BUG ')
16105          ENDIF
16106 4960   CONTINUE
16107        CALL IgrColourN(2)
16108      ELSE
16109        CALL IGrPaletteInit()
16110        CALL IgrColourN(223)
16111      ENDIF
16112      CALL IGrArea(0.,0.,1.,1.)
16113      CALL IGrAreaClear()
16114      CALL IGrUnits(0.,0.,100.,100.)
16115      ISTEMP=' '
16116      ISTEMP(1:NCPATH)=PATH(1:NCPATH)
16117      NC1=NCPATH+1
16118      NC2=NCPATH+9
16119      ISTEMP(NC1:NC2)='fixed.chr'
16120      IERRO2=0
16121      CALL IGrCharSet(ISTEMP)
16122CCCCC CALL IGrCharSet('H')
16123        IERRO2=InfoError(1)
16124        ISTAT2=InfoError(2)
16125        IF(IERRO2.EQ.1 .OR. IERRO2.EQ.2)THEN
16126          WRITE(ICOUT,4979)
16127 4979     FORMAT('*****LAHEY: ERROR LOADING FONT FILE')
16128          CALL DPWRST('XXX','BUG ')
16129        ENDIF
16130      CALL IGrCharSpacing('F')
16131CCCCC CALL WindowSelect(IHAND1)
16132      CALL IGrLineType(0)
16133#endif
16134      GOTO9000
16135C
16136C
16137C               ******************************************************
16138C               **  STEP 51--                                       **
16139C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
16140C               **  TO INITIALIZE DEVICE--                          **
16141C               **  USE THE 70 OP CODE (= RESET)                    **
16142C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
16143C               **             MODELS 3600SX AND 3653SX             **
16144C               **             PAGES B-0 , B-1, AND E-1             **
16145C               **  MARCH, 1988 - USE ZETA EXTENDED CALCOMP LIBRARY **
16146C               **  PLOTS - INITIALIZES DEVICE                      **
16147C               **  DASHDF - DEFINE DEFAULT DASHED LINE PATTERNS    **
16148C               ******************************************************
16149C
16150 5100 CONTINUE
16151C
16152C     USE THE CALCOMP LIBRARY ROUTINES
16153C
16154      IUNIT=IGUNIT
16155      REWIND(IUNIT)
16156      IREL=53
16157      IDUM=0
16158#ifdef HAVE_ZETA
16159      CALL PLOTS(IREL,IDUM,IUNIT)
16160      CALL DASHDF(0,0,0,0)
16161#endif
16162      GOTO9000
16163C
16164C               ******************************************************
16165C               **  STEP 66--                                       **
16166C               **  TREAT THE SUN CASE                              **
16167C               **  WRITTEN BY BILL ANDERSON                        **
16168C               ******************************************************
16169C
16170 6600 CONTINUE
16171      IDUMMY=0
16172#ifdef HAVE_SUN
16173      CALL isitcolor(IDUMMY)
16174#endif
16175      ISUNCL=IDUMMY
16176      IF (ISUNCL.LT.0) THEN
16177         WRITE(ICOUT,6601)
16178 6601    FORMAT('Trouble opening SUN graphics window')
16179         CALL DPWRST('XXX','BUG ')
16180         GOTO 6620
16181      ENDIF
16182      IF(ISUNCL.EQ.1)THEN
16183         DD = 5
16184         CMAPSZ = 8
16185         CMAPNM = 'DATAPLOT'
16186      ELSE
16187         DD = 4
16188      ENDIF
16189#ifdef HAVE_SUN
16190      CALL cfopencgi()
16191#endif
16192      RETNED = 1
16193#ifdef HAVE_SUN
16194      CALL cfopenvws(IVSNAM,SCNNAM,WINNAM,WINDFD,
16195     1  RETNED,DD,CMAPSZ,CMAPNM,FLAGS,PTR,NOARGS,
16196     2  200,200,200,200)
16197#endif
16198      IF(ISUNCL.EQ.1) THEN
16199C    BLACK(I.E. 'DARK')
16200C    APRIL 1990: FOLLOWING 3 LINES MODIFIED AT SUGGESTION OF BILL ANDERSON.
16201C                SEEMS THAT ON 3/80 SUN'S, SETTING TO 0 GIVES WHITE, NOT
16202C                BLACK.
16203CCCCC    RD(1) = 0
16204CCCCC    GN(1) = 0
16205CCCCC    BE(1) = 0
16206         RD(1) = 1
16207         GN(1) = 1
16208         BE(1) = 1
16209C    RED
16210         RD(2) = 244
16211         GN(2) = 9
16212         BE(2) = 6
16213C    GREEN
16214         RD(3) = 50
16215         GN(3) = 198
16216         BE(3) = 12
16217C    BLUE
16218         RD(4) = 120
16219         GN(4) = 215
16220         BE(4) = 247
16221C    YELLOW
16222         RD(5) = 254
16223         GN(5) = 241
16224         BE(5) = 108
16225C    ORANGE
16226C        RD(6) = 245
16227C        GN(6) = 176
16228C        BE(6) = 33
16229C    BLACK
16230C    APRIL 1990, SAME PATCH AS ABOVE
16231CCCCC    RD(6) = 0
16232CCCCC    GN(6) = 0
16233CCCCC    BE(6) = 0
16234         RD(1) = 1
16235         GN(1) = 1
16236         BE(1) = 1
16237C    PURPLE
16238         RD(7) = 189
16239         GN(7) = 102
16240         BE(7) = 249
16241C    WHITE
16242         RD(8) = 255
16243         GN(8) = 255
16244         BE(8) = 255
16245#ifdef HAVE_SUN
16246         CALL cfcotable(0,RD,GN,BE,8)
16247#endif
16248      ENDIF
16249#ifdef HAVE_SUN
16250      CALL cfvdcext(1,1,10000,10000)
16251      CALL cftextprec(1)
16252      CALL cffixedfont(1)
16253      CALL cfcharexpfac(.5)
16254      CALL cfcharspacing(0.)
16255      CALL cfintstyle(1,1)
16256#endif
16257 6620 CONTINUE
16258      GOTO9000
16259C
16260C               ******************************************************
16261C               **  STEP 81--                                       **
16262C               **  TREAT THE DEC  REGIS CASE                       **
16263C               **  TO INITIALIZE DEVICE---                         **
16264C               **  WRITE OUT AN   XX                               **
16265C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
16266C               **             PAGES XX AND XX                      **
16267C               ******************************************************
16268C
16269 8100 CONTINUE
16270      IREGMC=3
16271      IF(IMODEL.EQ.'340'.OR.IMODEL.EQ.'VT-3')IREGMC=15
16272      GOTO9000
16273C
16274C               ******************************************************
16275C               **  STEP 86                                         **
16276C               **  TREAT THE POSTSCRIPT  CASE                      **
16277C               **  1) DEFINE 8 PROCEDURES:                         **
16278C               **     RIGHTSHOW -  PRINT A RIGHT JUSTIFIED STRING  **
16279C               **     CENTSHOW  -  PRINT A CENTER JUSTIFIED STRING **
16280C               **     LEFTSHOW  -  PRINT A LEFT JUSTIFIED STRING   **
16281C               **     VRIGHTSHOW - PRINT A VERTICAL RIGHT (I.E.,   **
16282C               **                  TOP) JUSTIFIED STRING           **
16283C               **     VCENTSHOW  - PRINT A VERTICAL CENTER         **
16284C               **                  JUSTIFIED STRING                **
16285C               **     VLEFTSHOW  - PRINT A VERTICAL LEFT (I.E.,    **
16286C               **                  BOTTOM) JUSTIFIED STRING        **
16287C               **     L          - ABBREVIATION FOR LINETO         **
16288C               **     M          - ABBREVIATION FOR MOVETO         **
16289C               **  2) SET INITIAL HARDWARE FONT (DEF = TIMES-ROMAN)**
16290C               **     FOR DATAPLOT DEFAULT SIZE (HEIGHT = 2.0,     **
16291C               **     USE 12 POINT FONT                            **
16292C               **     THE VERTICAL GAP IS NOT PART OF THE HEIGHT   **
16293C               **     THE CURRENT FONT AND POINT SIZE ARE STORED IN**
16294C               **     THE DEVICE COMMON BLOCKS AND MAY BE CHANGED  **
16295C               **     VIA "SET" COMMANDS.                          **
16296C               **  3) SCALE PLOT TO DESIRED POINTS PER INCH        **
16297C               **     (POSTSCRIPT DEFAULT IS 72, MOST DEVICES 300) **
16298C               **  REFERENCE--POSTSCRIPT LANGUAGE TUTORIAL AND     **
16299C               **             COOKBOOK, ADOBE SYSTEMS              **
16300C               **             POSTSCRIPT LANGUAGE REFERENCE        **
16301C               **             MANUAL, ADOBE SYSTEMS                **
16302C               **  NOTE: POSTSCRIPT IS CASE SENSITIVE!!!           **
16303C               **  MODIFIED JANUARY 1990.                          **
16304C               **  A) SUPPORT ENCAPSULATED POSTSCRIPT              **
16305C               **     NOTE THAT ENCAPSULATED POSTSRIPT MEANS EACH **
16306C               **     PAGE MUST BE SELF-CONTAINED, SO STUFF NORMALLY*
16307C               **     DONE HERE WILL BE DONE IN GRERSC INSTEAD.    **
16308C               **     IF MORE THAN ONE PAGE GENERATED, THE USER    **
16309C               **     WILL NEED TO SPLIT THE FILE UP VIA AN EDITOR **
16310C               **     TO PUT EACH PAGE INTO A SEPARATE FILE.       **
16311C               **  B) ENCAPSULATED POSTSCRIPT MUST BE IN           **
16312C               **     "CONFORMING" STYLE (SEE APPENDIX C OF        **
16313C               **     POSTSCRIPT LANGUAGE REFERENCE MANUAL BOOK    **
16314C               **     (THE RED ONE) FOR DETAILS.  FOR CONSISTENCY, **
16315C               **     USE CONFORMING STYLE EVEN IF DO NOT USE      **
16316C               **     ENCAPSULATED POSTSCRIPT.                     **
16317C               **  NOTE THAT ENCAPSULATED POSTSCRIPT SHOULD ONLY   **
16318C               **  BE USED IF NEEDED TO INTEGRATE INTO ANOTHER     **
16319C               **  PROGRAM (E.G., WORDPERFECT OR PAGE MAKER).      **
16320C               ******************************************************
16321C
16322C  NOVEMBER, 1990 BUG FIX.  MODIFIED HOW MARGINS ARE HANDLED.
16323C  OCTOBER, 1991.  ADDITIONAL FONTS, ALSO "%!" IN COL. 1 OR COL. 2
16324C  DECEMBER 1991.  BUG FIX IN BOUNDING BOX (SHOULD BE BASED ON DEFAULT
16325C  POSTSCRIPT UNITS, NOT IN DATAPLOT POSTSCRIPT UNITS).
16326C  JANUARY 1993.  NO LEADING SPACE BEFORE "%%" CAUSED PROBLEM WITH
16327C  FRAMEMAKER.
16328C  JANUARY  2003: DATAPLOT SETS BOUNDING BOX TO 11INx11IN BY DEFAULT
16329C                 SINCE IT CAN SWITCH BETWEEN LANDSCAPE/PORTRAIT
16330C                 MODES.  HOWEVER, SOMETIMES FOR IMPORTING INTO OTHER
16331C                 PROGRAMS, IT IS PREFFERABLE TO SET THE BOUNDING BOX
16332C                 MORE EXPLICITLY (I.E., LANDSCAPE OR PORTRAIT).  THE
16333C                 SET POSTSCRIPT BOUNDING BOX FIXED COMMAND WILL SET
16334C                 THIS EXPLICIT BOUNDING BOX.
16335C  JANUARY  2003: DATAPLOT DOES AN INITIAL PAGE ERASE IN CASE
16336C                 DIAGRAMMATIC GRAPHICS BEING GENERATED.  SET AN INTERNAL
16337C                 VARIABLE (IPSTNW) TO INDICATE PAGE ERASE HAS BEEN
16338C                 PERFORMED.
16339C  FEBRUARY 2009: ADD SEVERAL PROCEDURES TO FACILITATE SUPPORT FOR
16340C                 SUBSCRIPTS/SUPERSCRIPTS AND GREEK CHARACTERS
16341C                 (setpsfont, psstringwidth, addstringwidth,
16342C                 leftshow2, vleftshow2)
16343C
16344C  JANUARY  1990: FOLLOWING SECTION MODIFIED TO BE "CONFORMING"
16345C                 POSTSCRIPT
16346C  JANUARY  1993. ONLY SET PAGE NUMBER FOR DEVICE 2
16347C  NOVEMBER 2015. THE "SET DEVICE 3 <AUTOMATIC/USER>" COMMAND ALLOWS
16348C                 THE USER TO SPECIFY WHETHER DEVICE 3 OUTPUT WILL BE
16349C                 HANDLED AUTOMATICALLY BY DATAPLOT OR EXPLICITLY
16350C                 BY THE USER.  WHEN HANDLED AUTOMATICALLY, MODEL 3
16351C                 IS SET TO "DEV3".  WHEN CONTROLLED BY THE USER, WE
16352C                 NEED TO MAINTAIN SEPARATE PAGE NUMBERING FOR
16353C                 DEVICE 2 AND DEVICE 3 (COMPARE IGUNIT TO IPL1NU/
16354C                 IPL2NU TO DETERMINE WHICH DEVICE IS ACTIVE).
16355C
16356 8600 CONTINUE
16357C
16358      IF(IMODE3.NE.'DEV3')THEN
16359        IF(IGUNIT.EQ.IPL1NU)IPSTPN=0
16360        IF(IGUNIT.EQ.IPL2NU)IPSTP2=0
16361      ENDIF
16362      IF(IMODEL.EQ.'ENCA')GOTO9000
16363CCCCC ICSTR(1:40)='%! - THIS LINE REQUIRED FOR UNIX SYSTEMS'
16364CCCCC FOLLOWING LINES MODIFIED.  SOME SYSTEMS WANT COLUMN 1, OTHERS COLUMN 2
16365      ICSTR(1:14)='%!PS-Adobe-2.0'
16366      NCSTR=14
16367      IF(IPSTSP.EQ.'OFF'.OR.IPSTSP.EQ.'NO'.OR.IPSTSP.EQ.'FALS')THEN
16368        IPSTSP='OFF'
16369        NCSTR=-14
16370      END IF
16371C  END CHANGE
16372      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16373      IF(IGFLAG.EQ.1)GOTO9000
16374C
16375C  FOLLOWING LINES ADDED JANUARY, 1990.
16376C
16377C  JANUARY 1993.  NO LEADING SPACE BEFORE "%%"
16378C
16379      ICSTR(1:19)='%%Creator: Dataplot'
16380      NCSTR=19
16381      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
16382      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16383      ICSTR(1:33)='%%Title: Dataplot Postscript File'
16384      NCSTR=33
16385      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
16386      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16387      ICSTR(1:20)='%%CreationDate: NULL'
16388      NCSTR=20
16389      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
16390      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16391      ICSTR(1:16)='%%Pages: (atend)'
16392      NCSTR=16
16393      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
16394      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16395      ICSTR(1:40)='%%DocumentFonts: Times-Roman Times-Bold '
16396      ICSTR(41:69)='Times-Italic Times-BoldItalic'
16397      NCSTR=69
16398      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
16399      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16400      ICSTR(1:46)='%%+ Helvetica Helvetica-Bold Helvetica-Oblique'
16401      ICSTR(47:76)=' Helvetica-BoldOblique Courier'
16402      NCSTR=76
16403      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
16404      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16405      ICSTR(1:33)='%%+ Courier-Bold Courier-Oblique '
16406      ICSTR(34:53)=' Courier-BoldOblique'
16407      NCSTR=53
16408      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
16409      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16410C  OCTOBER 1991.  ADDITIONAL FONTS ADDED
16411      ICSTR(1:42)='%%+ AvantGarde-Book AvantGarde-BookOblique'
16412      ICSTR(43:81)=' AvantGarde-Demi AvantGarde-DemiOblique'
16413      NCSTR=81
16414      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
16415      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16416      ICSTR(1:42)='%%+ Bookman-Demi Bookman-DemiItalic       '
16417      ICSTR(43:81)='Bookman-Light Bookman-LightItalic      '
16418      NCSTR=81
16419      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
16420      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16421      ICSTR(1:42)='%%+ Helvetica-Narrow Helvetica-Narrow-Bold'
16422      ICSTR(43:81)=' Helvetica-Narrow-BoldOblique          '
16423      NCSTR=81
16424      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
16425      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16426      ICSTR(1:42)='%%+ Helvetica-Narrow-Oblique              '
16427      ICSTR(43:81)='NewCentury-Schlbk-Bold                 '
16428      NCSTR=81
16429      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
16430      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16431      ICSTR(1:42)='%%+ NewCentury-Schlbk-Italic              '
16432      ICSTR(43:81)='NewCenturySchlbk-BoldItalic            '
16433      NCSTR=81
16434      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
16435      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16436      ICSTR(1:42)='%%+ Palatino-Roman Palatino-Bold          '
16437      ICSTR(43:81)='Palatino-Italic Palatino-BoldItalic    '
16438      NCSTR=81
16439      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
16440      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16441      ICSTR(1:42)='%%+ ZapfChancery-MediumItalic  Symbol     '
16442      ICSTR(43:81)='                                       '
16443      NCSTR=81
16444      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
16445      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16446C  END CHANGE
16447      ICSTR(1:19)='%%BoundingBox: 0 0 '
16448      NCSTR=19
16449      NCHTOT=5
16450C  DECEMBER 1991.  FOLLOWING LINE CHANGED.  BASE ON DEFAULT POSTSCRIPT
16451C  UNITS (72 PPI) RATHER THAN DATAPLOT UNITS.
16452C  JANUARY 2003.  BOUNDING BOX CAN BE EITHER FIXED (LANDSCAPE OR
16453C  PORTRAIT) OR FLOATING (CAN SWITCH BETWEEN LANDSCAPE OR PORTRAIT).
16454CCCCC IJUNK=INT(PSTPPI*11.+0.5)
16455CCCCC IJUNK=INT(72.*11.+0.5)
16456CCCCC CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
16457CCCCC NCSTR=NCSTR+1
16458CCCCC ICSTR(NCSTR:NCSTR)=' '
16459CCCCC CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
16460CCCCC IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
16461CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16462CCCCC ICSTR(1:13)='%%EndComments'
16463CCCCC NCSTR=13
16464      IF(IPSTBB.EQ.'FIXE')THEN
16465        IF(IORNSW.EQ.'PORT')THEN
16466          ICSTR(1:26)='%%BoundingBox: 0 0 612 792'
16467          NCSTR=26
16468        ELSEIF(IORNSW.EQ.'LAND')THEN
16469          ICSTR(1:26)='%%BoundingBox: 0 0 792 612'
16470          NCSTR=26
16471        ELSEIF(IORNSW.EQ.'LAN2')THEN
16472          ICSTR(1:26)='%%BoundingBox: 0 0 612 468'
16473          NCSTR=26
16474        ELSEIF(IORNSW.EQ.'SQUA')THEN
16475          ICSTR(1:26)='%%BoundingBox: 0 0 612 612'
16476          NCSTR=26
16477        ELSE
16478          ICSTR(1:26)='%%BoundingBox: 0 0 792 792'
16479          NCSTR=26
16480        ENDIF
16481      ELSE
16482        ICSTR(1:26)='%%BoundingBox: 0 0 792 792'
16483        NCSTR=26
16484      ENDIF
16485      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
16486      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16487C  END JANUARY 1993 CHANGES
16488C
16489      ICSTR(1:43)='% DATAPLOT POSTSCRIPT DRIVER, JANUARY, 1990'
16490      NCSTR=43
16491      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16492      ICSTR(1:43)='% PROLOG SECTION: DATAPLOT DEFINITIONS     '
16493      NCSTR=43
16494      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16495C
16496      ICSTR(1:44)='%DEFINE PROCEDURE "rightshow" TO PRINT RIGHT'
16497      ICSTR(45:72)=' JUSTIFIED STRING.  CALL BY:'
16498      NCSTR=72
16499      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16500      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
16501      NCSTR=35
16502      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16503      ICSTR(1:20)='% (STRING) rightshow'
16504      NCSTR=20
16505      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16506      ICSTR(1:10)='/rightshow'
16507      NCSTR=10
16508      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16509      ICSTR(1:22)='  {dup stringwidth pop'
16510      NCSTR=22
16511      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16512      ICSTR(1:14)='   IX exch sub'
16513      NCSTR=14
16514      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16515      ICSTR(1:12)='   IY moveto'
16516      NCSTR=12
16517      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16518      ICSTR(1:12)='   show} def'
16519      NCSTR=12
16520      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16521C
16522      ICSTR(1:44)='%DEFINE PROCEDURE "centshow" TO PRINT CENTER'
16523      ICSTR(45:72)=' JUSTIFIED STRING.  CALL BY:'
16524      NCSTR=72
16525      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16526      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
16527      NCSTR=35
16528      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16529      ICSTR(1:19)='% (STRING) centshow'
16530      NCSTR=19
16531      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16532      ICSTR(1:9)='/centshow'
16533      NCSTR=9
16534      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16535      ICSTR(1:22)='  {dup stringwidth pop'
16536      NCSTR=22
16537      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16538      ICSTR(1:8)='   2 div'
16539      NCSTR=8
16540      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16541      ICSTR(1:14)='   IX exch sub'
16542      NCSTR=14
16543      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16544      ICSTR(1:12)='   IY moveto'
16545      NCSTR=12
16546      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16547      ICSTR(1:12)='   show} def'
16548      NCSTR=12
16549      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16550C
16551      ICSTR(1:44)='%DEFINE PROCEDURE "leftshow" TO PRINT LEFT  '
16552      ICSTR(45:72)=' JUSTIFIED STRING.  CALL BY:'
16553      NCSTR=72
16554      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16555      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
16556      NCSTR=35
16557      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16558      ICSTR(1:19)='% (STRING) leftshow'
16559      NCSTR=19
16560      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16561      ICSTR(1:9)='/leftshow'
16562      NCSTR=9
16563      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16564      ICSTR(1:25)='  {IX IY moveto show} def'
16565      NCSTR=25
16566      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16567C
16568      ICSTR(1:45)='%DEFINE PROCEDURE "vrightshow" TO PRINT RIGHT'
16569      ICSTR(46:82)=' JUSTIFIED VERTICAL STRING.  CALL BY:'
16570      NCSTR=82
16571      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16572      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
16573      NCSTR=35
16574      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16575      ICSTR(1:28)='% newpath IX IY moveto gsave'
16576      NCSTR=28
16577      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16578      ICSTR(1:30)='% (STRING) vrightshow grestore'
16579      NCSTR=30
16580      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16581      ICSTR(1:11)='/vrightshow'
16582      NCSTR=11
16583      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16584      ICSTR(1:22)='  {dup stringwidth pop'
16585      NCSTR=22
16586      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16587      ICSTR(1:14)='   IY exch sub'
16588      NCSTR=14
16589      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16590      ICSTR(1:17)='   IX exch moveto'
16591      NCSTR=17
16592      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16593      ICSTR(1:13)='    90 rotate'
16594      NCSTR=13
16595      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16596      ICSTR(1:12)='   show} def'
16597      NCSTR=12
16598      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16599C
16600      ICSTR(1:45)='%DEFINE PROCEDURE "vcentshow" TO PRINT CENTER'
16601      ICSTR(46:82)=' JUSTIFIED VERTICAL STRING.  CALL BY:'
16602      NCSTR=82
16603      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16604      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
16605      NCSTR=35
16606      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16607      ICSTR(1:28)='% newpath IX IY moveto gsave'
16608      NCSTR=28
16609      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16610      ICSTR(1:29)='% (STRING) vcentshow grestore'
16611      NCSTR=29
16612      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16613      ICSTR(1:10)='/vcentshow'
16614      NCSTR=10
16615      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16616      ICSTR(1:22)='  {dup stringwidth pop'
16617      NCSTR=22
16618      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16619      ICSTR(1:8)='   2 div'
16620      NCSTR=8
16621      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16622      ICSTR(1:14)='   IY exch sub'
16623      NCSTR=14
16624      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16625      ICSTR(1:17)='   IX exch moveto'
16626      NCSTR=17
16627      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16628      ICSTR(1:14)='     90 rotate'
16629      NCSTR=14
16630      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16631      ICSTR(1:12)='   show} def'
16632      NCSTR=12
16633      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16634C
16635      ICSTR(1:45)='%DEFINE PROCEDURE "vleftshow" TO PRINT LEFT  '
16636      ICSTR(46:82)=' JUSTIFIED VERTICAL STRING.  CALL BY:'
16637      NCSTR=82
16638      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16639      ICSTR(1:35)='%  /IX <XCOOR> def /IY <YCOOR> def '
16640      NCSTR=35
16641      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16642      ICSTR(1:28)='% newpath IX IY moveto gsave'
16643      NCSTR=28
16644      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16645      ICSTR(1:29)='% (STRING) vleftshow grestore'
16646      NCSTR=29
16647      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16648      ICSTR(1:10)='/vleftshow'
16649      NCSTR=10
16650      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16651      ICSTR(1:36)='  {IX IY moveto 90 rotate show} def'
16652      NCSTR=36
16653      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16654C
16655CCCCC FEBRUARY 2009: ADD "setpsfont" PROCEDURE TO DEFINE THE
16656CCCCC                POSTSCRIPT FONT.
16657C
16658      ICSTR(1:44)='%DEFINE PROCEDURE "setpsfont" TO DEFINE THE '
16659      ICSTR(45:84)='POSTSCRIPT FONT NAME AND SIZE.  CALL BY:'
16660      NCSTR=84
16661      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16662      ICSTR(1:48)='%  /PSFONT <FONTNAME> def /PSSIZE <FONTSIZE> def'
16663      ICSTR(49:58)=' setpsfont'
16664      NCSTR=58
16665      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16666      ICSTR(1:10)='/setpsfont'
16667      NCSTR=10
16668      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16669      ICSTR(1:52)='  {PSFONT  findfont  PSSIZE  scalefont  setfont} def'
16670      NCSTR=52
16671      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16672C
16673CCCCC FEBRUARY 2009: ADD "psstringwidthr" PROCEDURE TO MOVE THE
16674CCCCC                STARTING POSITION OF A RIGHT JUSTIFIED STRING.
16675C
16676      ICSTR(1:47) ='%DEFINE PROCEDURE "psstringwidthr" TO MOVE THE '
16677      ICSTR(48:93)='STARTING POSITION OF A RIGHT JUSTIFIED STRING.'
16678      NCSTR=93
16679      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16680      NCSTR=9
16681      ICSTR(1:NCSTR)='%CALL BY:'
16682      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16683      NCSTR=26
16684      ICSTR(1:NCSTR)='%  (STRING) psstringwidthr'
16685      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16686      NCSTR=15
16687      ICSTR(1:NCSTR)='/psstringwidthr'
16688      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16689      NCSTR=48
16690      ICSTR(1:NCSTR)='  {dup stringwidth pop 0 exch sub 0 rmoveto} def'
16691      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16692C
16693CCCCC FEBRUARY 2009: ADD "psstringwidthc" PROCEDURE TO MOVE THE
16694CCCCC                STARTING POSITION OF A CENTER JUSTIFIED STRING.
16695C
16696      ICSTR(1:47) ='%DEFINE PROCEDURE "psstringwidthc" TO MOVE THE '
16697      ICSTR(48:94)='STARTING POSITION OF A CENTER JUSTIFIED STRING.'
16698      NCSTR=94
16699      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16700      NCSTR=9
16701      ICSTR(1:NCSTR)='%CALL BY:'
16702      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16703      NCSTR=26
16704      ICSTR(1:NCSTR)='%  (STRING) psstringwidthc'
16705      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16706      NCSTR=15
16707      ICSTR(1:NCSTR)='/psstringwidthc'
16708      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16709      NCSTR=55
16710      ICSTR(1:50)='  {dup stringwidth pop 2 div 0 exch sub 0 rmoveto}'
16711      ICSTR(51:NCSTR)='  def'
16712      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16713C
16714CCCCC FEBRUARY 2009: ADD "psstringwidthtv" PROCEDURE TO MOVE THE
16715CCCCC                STARTING POSITION OF A RIGHT JUSTIFIED STRING.
16716C
16717      ICSTR(1:48) ='%DEFINE PROCEDURE "psstringwidthtv" TO MOVE THE '
16718      ICSTR(49:92)='STARTING POSITION OF A TOP JUSTIFIED VERTICAL'
16719      ICSTR(93:100)=' STRING.'
16720      NCSTR=100
16721      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16722      NCSTR=9
16723      ICSTR(1:NCSTR)='%CALL BY:'
16724      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16725      NCSTR=27
16726      ICSTR(1:NCSTR)='%  (STRING) psstringwidthtv'
16727      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16728      NCSTR=16
16729      ICSTR(1:NCSTR)='/psstringwidthtv'
16730      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16731      NCSTR=56
16732      ICSTR(1:44)='  {dup stringwidth pop 0 exch sub 0 exch '
16733      ICSTR(45:NCSTR)='rmoveto} def'
16734      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16735C
16736CCCCC FEBRUARY 2009: ADD "psstringwidthcv" PROCEDURE TO MOVE THE
16737CCCCC                STARTING POSITION OF A CENTER JUSTIFIED VERTICAL STRING.
16738C
16739      ICSTR(1:48) ='%DEFINE PROCEDURE "psstringwidthcv" TO MOVE THE '
16740      ICSTR(49:87)='STARTING POSITION OF A CENTER JUSTIFIED'
16741      ICSTR(88:103)='VERTICAL STRING.'
16742      NCSTR=103
16743      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16744      NCSTR=9
16745      ICSTR(1:NCSTR)='%CALL BY:'
16746      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16747      NCSTR=27
16748      ICSTR(1:NCSTR)='%  (STRING) psstringwidthcv'
16749      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16750      NCSTR=16
16751      ICSTR(1:NCSTR)='/psstringwidthcv'
16752      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16753      NCSTR=59
16754      ICSTR(1:46)='  {dup stringwidth pop 2 div 0 exch sub 0 exch'
16755      ICSTR(47:NCSTR)=' rmoveto} def'
16756      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16757C
16758      ICSTR(1:45)='%DEFINE PROCEDURE "leftshow2" TO PRINT LEFT  '
16759      ICSTR(45:93)=' JUSTIFIED STRING AT CURRENT POSITION.  CALL BY:'
16760      NCSTR=93
16761      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16762      ICSTR(1:20)='% (STRING) leftshow2'
16763      NCSTR=20
16764      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16765      ICSTR(1:10)='/leftshow2'
16766      NCSTR=10
16767      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16768      ICSTR(1:12)='  {show} def'
16769      NCSTR=12
16770      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16771C
16772      ICSTR(1:47)='%DEFINE PROCEDURE "vleftshow2" TO PRINT BOTTOM  '
16773      ICSTR(48:84)=' JUSTIFIED VERTICAL STRING.  CALL BY:'
16774      NCSTR=84
16775      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16776      NCSTR=21
16777      ICSTR(1:NCSTR)='% (STRING) vleftshow2'
16778      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16779      NCSTR=11
16780      ICSTR(1:NCSTR)='/vleftshow2'
16781      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16782      NCSTR=33
16783      ICSTR(1:NCSTR)='  {90 rotate show -90 rotate} def'
16784      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16785C
16786      ICSTR(1:52)='% DEFINE PROCEDURE "l" AS ABBREVIATION OF lineto'
16787      NCSTR=52
16788      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16789      ICSTR(1:15)='/l {lineto} def'
16790      NCSTR=15
16791      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16792C
16793      ICSTR(1:52)='% DEFINE PROCEDURE "m" AS ABBREVIATION OF moveto'
16794      NCSTR=52
16795      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16796      ICSTR(1:15)='/m {moveto} def'
16797      NCSTR=15
16798      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16799C
16800C  ***************************************************************
16801C  **  SET DEFAULT POSTSCRIPT FONT TO BE TIMES-ROMAN.  NOTE     **
16802C  **  THAT THE DEFAULT DATAPLOT SIZE IS 2.0 FOR THE CHARACTER  **
16803C  **  AND 0.75 FOR THE VERTICAL GAP.  POSTSCRIPT WORKS IN      **
16804C  **  "POINTS" WHICH ARE 1/72 AN INCH.  HOWEVER, DATAPLOT      **
16805C  **  POSTSCRIPT UNITS (72 DOTS PER INCH) TO THE ACTUAL DOTS   **
16806C  **  PER INCH (TYPICALLY 300).  THIS MEANS 1 UNIT CORRESPONDS **
16807C  **  TO ONE PIXEL OR DOT.  THE DEFAULT FONT WILL BE RESET     **
16808C  **  EVERY TIME AN ERASE PAGE IS DONE (SINCE GRERSC DOES A    **
16809C  **  "GRESTORE" COMMAND.  THE USER CAN DETERMINE THE DEFAULT  **
16810C  **  STYLE VIA A "SET POSCRIPT FONT <...> COMMAND.            **
16811C  ***************************************************************
16812C
16813C  MAY,1989, ALAN HECKERT.  BE SURE TO DEFINE THE DEFAULT PAGE SCALING,
16814C  TRANSLATION AND ORIENTATION (WAS A BUG WITH DIAGRAMMATIC GRAPHICS
16815C  IF AN ERASE WAS NOT DONE FIRST).
16816C  FOLLOWING CODE MODIFIED OCTOBER 1991.  MAKE FONT TABLE DRIVEN
16817      APOINT=ANUMVP*2.0/100.
16818      IPOINT=INT(APOINT)
16819C
16820      IJUNK=7
16821      DO8695I=1,IPSTMF
16822      IF(IPSTFN.NE.IPSTT1(I))GOTO8695
16823      IJUNK=I
16824      GOTO8697
16825 8695 CONTINUE
16826 8697 CONTINUE
16827      ICSTR(1:1)='/'
16828      ICSTR(2:41)=IPSTT2(IJUNK)(1:40)
16829      ICSTR(42:51)=' findfont '
16830      NCHTOT=3
16831      NCSTR=51
16832      CALL GRTRIN(IPOINT,NCHTOT,ICSTR,NCSTR)
16833      NCSTR=NCSTR+1
16834      NCSTR2=NCSTR+17
16835      ICSTR(NCSTR:NCSTR2)=' scalefont setfont'
16836      NCSTR=NCSTR2
16837      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16838CCCCC ICSTR(1:33)='/Times-Roman            findfont '
16839CCCCC IF(IPSTFN.EQ.'TBOL')
16840CCCCC1ICSTR(1:23)='/Times-Bold            '
16841CCCCC IF(IPSTFN.EQ.'TITA')
16842CCCCC1ICSTR(1:23)='/Times-Italic          '
16843CCCCC IF(IPSTFN.EQ.'TBIT')
16844CCCCC1ICSTR(1:23)='/Times-BoldItalic      '
16845CCCCC IF(IPSTFN.EQ.'HELV')
16846CCCCC1ICSTR(1:23)='/Helvetica             '
16847CCCCC IF(IPSTFN.EQ.'HELB')
16848CCCCC1ICSTR(1:23)='/Helvetica-Bold        '
16849CCCCC IF(IPSTFN.EQ.'HELO')
16850CCCCC1ICSTR(1:23)='/Helvetica-Oblique     '
16851CCCCC IF(IPSTFN.EQ.'HEBO')
16852CCCCC1ICSTR(1:23)='/Helvetica-BoldOblique '
16853CCCCC IF(IPSTFN.EQ.'COUR')
16854CCCCC1ICSTR(1:23)='/Courier               '
16855CCCCC IF(IPSTFN.EQ.'CBOL')
16856CCCCC1ICSTR(1:23)='/Courier-Bold          '
16857CCCCC IF(IPSTFN.EQ.'COBL')
16858CCCCC1ICSTR(1:23)='/Courier-Oblique       '
16859CCCCC IF(IPSTFN.EQ.'CBOB')
16860CCCCC1ICSTR(1:23)='/Courier-BoldOblique   '
16861CCCCC NCSTR=33
16862CCCCC NCSTR=33
16863CCCCC NCHTOT=3
16864CCCCC CALL GRTRIN(IPOINT,NCHTOT,ICSTR,NCSTR)
16865CCCCC ICSTR(37:54)=' scalefont setfont'
16866CCCCC NCSTR=54
16867CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16868C
16869C  END CHANGE
16870      IPSTFC=IPSTFN
16871      IPSTPS=IPOINT
16872      IPSTPC=IPOINT
16873      IPSTPO=IPOINT
16874C  JUNE, 1989.  A NEW PAGE RESETS THE FONT TO WHAT IS SET IN GRINDE.
16875C  ADDED IPSTFO TO DPCODV AND MODIFIED GRERSC.
16876      IPSTFO=IPSTFN
16877C
16878      ICSTR(1:41)='gsave    % SAVE INITIAL GRAPHICS STATE'
16879      NCSTR=41
16880      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16881C  ADD FOLLOWING LINES JANUARY, 1990.
16882C  JANUARY 1993.  LEADING SPACE FOR "%%" LINES
16883      ICSTR(1:11)='%%EndProlog'
16884      NCSTR=11
16885      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
16886      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16887CCCCC JANUARY 1993.  ONLY INCREMENT FOR DEVICE 2!
16888      IF(IMODE3.NE.'DEV3')THEN
16889        IF(IGUNIT.EQ.IPL1NU)THEN
16890          IPSTPN=IPSTPN+1
16891          IVALT=IPSTPN
16892        ELSEIF(IGUNIT.EQ.IPL2NU)THEN
16893          IPSTP2=IPSTP2+1
16894          IVALT=IPSTP2
16895        ENDIF
16896      ELSE
16897         IVALT=1
16898      ENDIF
16899      ICSTR(1:8)='%%Page: '
16900      NCHTOT=1
16901      NCSTR=8
16902      CALL GRTRIN(IVALT,NCHTOT,ICSTR,NCSTR)
16903      NCSTR=NCSTR+1
16904      ICSTR(NCSTR:NCSTR)=' '
16905      CALL GRTRIN(IVALT,NCHTOT,ICSTR,NCSTR)
16906      IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR
16907      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16908C END ADDITIONS
16909      ICSTR(1:11)='0 0 moveto '
16910      NCSTR=11
16911      XPPI=PSTPPI
16912      YPPI=PSTPPI
16913      XSCALE=72./XPPI
16914      YSCALE=72./YPPI
16915      NCSTR=11
16916      NCHTOT=10
16917      NCHDEC=5
16918      CALL GRTRRE(XSCALE,NCHTOT,NCHDEC,ICSTR,NCSTR)
16919      ICSTR(22:22)=' '
16920      NCSTR=22
16921      CALL GRTRRE(YSCALE,NCHTOT,NCHDEC,ICSTR,NCSTR)
16922      ICSTR(33:39)=' scale '
16923      NCSTR=39
16924C
16925      IF(IORNSW.EQ.'LAND')THEN
16926        IVTEMP=IPSTBM
16927        IHTEMP=IPSTLM
16928      ELSEIF(IORNSW.EQ.'LAN2')THEN
16929        IVTEMP=IPS2BM
16930        IHTEMP=IPS2LM
16931      ELSEIF(IORNSW.EQ.'PORT')THEN
16932        IVTEMP=IPS2BM
16933        IHTEMP=IPS2LM
16934      ELSEIF(IORNSW.EQ.'SQUA')THEN
16935        IVTEMP=IPS2BM
16936        IHTEMP=IPS2LM
16937      ELSE
16938        IVTEMP=IPSTBM
16939        IHTEMP=IPSTLM
16940      END IF
16941      IXTR=IHTEMP
16942      IYTR=IVTEMP
16943      IF(IORNSW.NE.'PORT' .AND. IORNSW.NE.'LAN2' .AND. IORNSW.NE.'SQUA')
16944     1IXTR=IHTEMP+INT(ANUMVP+0.5)
16945      NCHTOT=5
16946      CALL GRTRIN(IXTR,NCHTOT,ICSTR,NCSTR)
16947      ICSTR(45:45)=' '
16948      NCSTR=45
16949      CALL GRTRIN(IYTR,NCHTOT,ICSTR,NCSTR)
16950      ICSTR(51:61)=' translate '
16951C
16952      ICSTR(62:63)=' 0'
16953      IF(IORNSW.NE.'PORT' .AND. IORNSW.NE.'LAN2' .AND. IORNSW.NE.'SQUA')
16954     1ICSTR(62:63)='90'
16955      ICSTR(64:71)=' rotate '
16956      NCSTR=71
16957      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16958C
16959      IF(IMODE3.NE.'DEV3')THEN
16960        IF(IGUNIT.EQ.IPL1NU)THEN
16961          IPSTNW='ON'
16962        ELSEIF(IGUNIT.EQ.IPL2NU)THEN
16963          IPSTN2='ON'
16964        ENDIF
16965      ENDIF
16966      GOTO9000
16967C
16968C               ******************************************************
16969C               **  STEP 90--                                       **
16970C               **  TREAT THE QUIC       CASE                       **
16971C               **  1) TURN QUIC ON - "^PY^-" ON LINE BY ITSELF     **
16972C               **  2) SET DEFAULT COMMAND SYNTAX - "^ISYNTAX00000" **
16973C               **  3) SET DEFAULT FONT           - "^ISxxxxx       **
16974C               **  REFERENCE--QUIC PROGRAMMING MANUAL              **
16975C               ******************************************************
16976C
16977 9100 CONTINUE
16978      CALL DPCONA(94,ICARAT)
16979      ICSTR(1:1)=ICARAT
16980      ICSTR(2:3)='PY'
16981      ICSTR(4:4)=ICARAT
16982      ICSTR(5:5)='-'
16983      NCSTR=-5
16984      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16985      ICSTR(1:1)=ICARAT
16986      ICSTR(2:13)='ISYNTAX00000'
16987      NCSTR=13
16988      KFONT=IQUIFN
16989      ICSTR(14:14)=ICARAT
16990      ICSTR(15:16)='IS'
16991      NCHTOT=-5
16992      NCSTR=16
16993      CALL GRTRIN(KFONT,NCHTOT,ICSTR,NCSTR)
16994      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
16995      IQUIFC=IQUIFN
16996      GOTO9000
16997C
16998C               ******************************************************
16999C               **  STEP 95--                                       **
17000C               **  TREAT THE X11        CASE                       **
17001C               **  USE A C LIBRARY WRITTEN BY ALAN HECKERT         **
17002C               ******************************************************
17003C
17004 9600 CONTINUE
17005#ifdef HAVE_X11
17006      IF(IORNSW.EQ.'LAND')THEN
17007        IORIEN=0
17008      ELSE IF(IORNSW.EQ.'PORT')THEN
17009        IORIEN=1
17010      ELSE IF(IORNSW.EQ.'SQUA')THEN
17011        IORIEN=3
17012      ELSE
17013        IORIEN=2
17014      END IF
17015C
17016      DO9610I=20,1,-1
17017        ILAST=I
17018        IF(IX11DN(I:I).NE.' ')GOTO9619
17019 9610 CONTINUE
17020 9619 CONTINUE
17021      DO9620I=1,ILAST
17022        CALL DPCOAN(IX11DN(I:I),IJUNK)
17023        IADE(I)=IJUNK
17024 9620 CONTINUE
17025      IADE(ILAST+1)=0
17026C
17027      DO9629I=1,8
17028      IWIND(I)=-1
17029 9629 CONTINUE
17030      ICOUNT=0
17031      IF(IMODEL.EQ.'    '.AND.IMODE2.EQ.'    ')GOTO9639
17032      CTEMP(1:4)=IMODEL(1:4)
17033      CTEMP(5:8)=IMODE2(1:4)
17034      ICOUNT=0
17035      DO9630I=8,1,-1
17036        IA=CTEMP(I:I)
17037        IF(IA.EQ.' ')GOTO9630
17038        ICOUNT=ICOUNT+1
17039        CALL DPCOAN(IA,IVALUE)
17040        IF(IVALUE.GE.48.AND.IVALUE.LE.57)THEN
17041          IWIND(ICOUNT)=IVALUE-48
17042        ELSEIF(IVALUE.GE.65.AND.IVALUE.LE.70)THEN
17043          IWIND(ICOUNT)=IVALUE-55
17044        ELSEIF(IVALUE.GE.97.AND.IVALUE.LE.102)THEN
17045          IWIND(ICOUNT)=IVALUE-87
17046        ELSE
17047          ICOUNT=1
17048          WRITE(ICOUT,9633)
17049          GOTO9639
17050        ENDIF
17051 9630 CONTINUE
17052 9633 FORMAT('***** WARNING--INVALID WINDOW ID FROM FRONT-END.  ',
17053     1       'A SEPARATE GRAPHICS WINDOW WILL BE OPENED.')
17054 9639 CONTINUE
17055      IERRNO=0
17056      IXPIX=0
17057      IYPIX=0
17058      CALL XINIT(IXTEMP,IYTEMP,IORIEN,IXPIX,IYPIX,IADE,IWIND,ICOUNT,
17059     1           IERRNO)
17060      IF(IERRNO.EQ.1) THEN
17061         WRITE(ICOUT,9651)
17062 9651    FORMAT('CANNOT OPEN X11 WINDOW.')
17063         CALL DPWRST('XXX','BUG ')
17064         IX11OF='OFF'
17065      ELSE
17066         IX11OF='ON'
17067         ANUMHP=REAL(IXPIX)
17068         ANUMVP=REAL(IYPIX)
17069      ENDIF
17070#endif
17071      GOTO9000
17072C
17073CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
17074C               *************************************************
17075C               **  STEP 100--                                 **
17076C               **  TREAT THE VGA VIA TURBO-C       CASE       **
17077C               **  USE A C DRIVER WRITTEN BY JJF              **
17078C               *************************************************
17079C
1708010000 CONTINUE
17081CTURB CALL TCINDE
17082      GOTO9000
17083C
17084C               ******************************************************
17085C               **  STEP 110--                                      **
17086C               **  TREAT THE GKS                DRIVER             **
17087C               ******************************************************
17088C
17089C     FOR GLI/GKS IMPLEMENTATION, THE DEFINED WORKSTATIONS ARE:
17090C
17091C       2 = GKS METAFILE
17092C       5 = WORKSTATION INDEPENDENT SEGMENT STORAGE
17093C       7 = CGM BINARY
17094C       8 = CGM CLEAR TEXT
17095C      16 = VT-330
17096C      17 = VT-340
17097C      38 = DIGITAL LN03 PLUS
17098C      41 = VAX UIS
17099C      51 = HP-GL GRAPHICS PLOTTER
17100C      53 = HP-GL GRAPHICS PLOTTER
17101C      61 = POSTSCRIPT (B/W)
17102C      62 = POSTSCRIPT (COLOR)
17103C      63 = DISPLAY POSTSCRIPT (B/W)
17104C      64 = DISPLAY POSTSCRIPT (COLOR)
17105C      72 = TEK-401X SERIES TERMINAL
17106C      82 = TEK-42XX SERIES TERMINAL
17107C      92 = DIGITAL LJ250 COMPANION COLOR PRINTER
17108C     101 = PORTABLE DOCUMENT FORMAT (PDF) (NORMAL)
17109C     102 = PORTABLE DOCUMENT FORMAT (PDF) (COMPRESSED)
17110C     104 = PBM (PORTABLE BITMAP)
17111C     201 = TAB 132/15-G TERMINAL
17112C     204 = MONTEREY MG200 DISPLAY TERMINAL
17113C     207 = IBM PC
17114C     210 = X DISPLAY
17115C     211 = X DISPLAY
17116C     214 = X DISPLAY w/SUN RLE RASTERFILE DUMP
17117C     215 = X DISPLAY w/COMPUSERVE GIF DUMP (87A)
17118C     218 = X DISPLAY w/COMPUSERVE GIF DUMP (89A)
17119C     217 = X DISPLAY w/FRAME BUFFER
17120C
1712111000 CONTINUE
17122#ifdef HAVE_GKS
17123      IGKSNU=IPR
17124      IWRKSP=-1
17125      CALL GOPKS(IGKSNU, IWRKSP)
17126      CALL GSASF(ASF)
17127      IGKSID=1
17128CCCCC IGKSTY=0
17129      IGKSTY=5
17130      IF(IMODEL.EQ.'2')THEN
17131        IGKSID=2
17132      ELSEIF(IMODEL.EQ.'GKS' .AND. IMODE2.EQ.'META')THEN
17133        IGKSID=2
17134      ELSEIF(IMODEL.EQ.'5')THEN
17135        IGKSID=5
17136      ELSEIF(IMODEL.EQ.'WISS')THEN
17137        IGKSID=5
17138      ELSEIF(IMODEL.EQ.'WORK' .AND. IMODE2.EQ.'INDE')THEN
17139        IGKSID=5
17140      ELSEIF(IMODEL.EQ.'7')THEN
17141        IGKSID=7
17142      ELSEIF(IMODEL.EQ.'CGM' .AND. IMODE2.EQ.'BINA')THEN
17143        IGKSID=7
17144      ELSEIF(IMODEL.EQ.'8')THEN
17145        IGKSID=8
17146      ELSEIF(IMODEL.EQ.'CGM' .AND. IMODE2.EQ.'CLEA')THEN
17147        IGKSID=8
17148      ELSEIF(IMODEL.EQ.'CGM' .AND. IMODE2.EQ.'TEXT')THEN
17149        IGKSID=8
17150      ELSEIF(IMODEL.EQ.'16')THEN
17151        IGKSID=16
17152      ELSEIF(IMODEL.EQ.'VT' .AND. IMODE2.EQ.'330')THEN
17153        IGKSID=16
17154      ELSEIF(IMODEL.EQ.'17')THEN
17155        IGKSID=17
17156      ELSEIF(IMODEL.EQ.'VT' .AND. IMODE2.EQ.'340')THEN
17157        IGKSID=17
17158      ELSEIF(IMODEL.EQ.'38')THEN
17159        IGKSID=38
17160      ELSEIF(IMODEL.EQ.'LN03' .AND. IMODE2.EQ.'PLUS')THEN
17161        IGKSID=38
17162      ELSEIF(IMODEL.EQ.'LN03')THEN
17163        IGKSID=38
17164      ELSEIF(IMODEL.EQ.'41')THEN
17165        IGKSID=41
17166      ELSEIF(IMODEL.EQ.'VAX' .AND. IMODE2.EQ.'UIS')THEN
17167        IGKSID=41
17168      ELSEIF(IMODEL.EQ.'51')THEN
17169        IGKSID=51
17170      ELSEIF(IMODEL.EQ.'HPGL')THEN
17171        IGKSID=51
17172      ELSEIF(IMODEL.EQ.'53')THEN
17173        IGKSID=53
17174      ELSEIF(IMODEL.EQ.'61')THEN
17175        IGKSID=61
17176      ELSEIF(IMODEL.EQ.'POST' .AND. IMODE2.EQ.'BW')THEN
17177        IGKSID=61
17178      ELSEIF(IMODEL.EQ.'POST' .AND. IMODE2.EQ.'BLAC')THEN
17179        IGKSID=61
17180      ELSEIF(IMODEL.EQ.'62')THEN
17181        IGKSID=62
17182      ELSEIF(IMODEL.EQ.'POST' .AND. IMODE2.EQ.'COLO')THEN
17183        IGKSID=62
17184      ELSEIF(IMODEL.EQ.'63')THEN
17185        IGKSID=63
17186      ELSEIF(IMODEL.EQ.'DISP' .AND. IMODE2.EQ.'POST' .AND.
17187     1       IMODE3.EQ.'BW')THEN
17188        IGKSID=63
17189      ELSEIF(IMODEL.EQ.'DISP' .AND. IMODE2.EQ.'POST' .AND.
17190     1       IMODE3.EQ.'BLAC')THEN
17191        IGKSID=63
17192      ELSEIF(IMODEL.EQ.'64')THEN
17193        IGKSID=64
17194      ELSEIF(IMODEL.EQ.'DISP' .AND. IMODE2.EQ.'POST' .AND.
17195     1       IMODE3.EQ.'COLO')THEN
17196        IGKSID=64
17197      ELSEIF(IMODEL.EQ.'72')THEN
17198        IGKSID=72
17199      ELSEIF(IMODEL.EQ.'TEKT' .AND. IMODE2.EQ.'401X')THEN
17200        IGKSID=72
17201      ELSEIF(IMODEL.EQ.'82')THEN
17202        IGKSID=82
17203      ELSEIF(IMODEL.EQ.'TEKT' .AND. IMODE2.EQ.'42XX')THEN
17204        IGKSID=82
17205      ELSEIF(IMODEL.EQ.'88')THEN
17206        IGKSID=88
17207CCCCC   IGKSTY=5
17208      ELSEIF(IMODEL.EQ.'92')THEN
17209        IGKSID=92
17210      ELSEIF(IMODEL.EQ.'DIGI' .AND. IMODE2.EQ.'LJ25')THEN
17211        IGKSID=92
17212      ELSEIF(IMODEL.EQ.'101')THEN
17213        IGKSID=101
17214      ELSEIF(IMODEL.EQ.'PDF' .AND. IMODE2.EQ.'NORM')THEN
17215        IGKSID=101
17216      ELSEIF(IMODEL.EQ.'102')THEN
17217        IGKSID=102
17218      ELSEIF(IMODEL.EQ.'PDF' .AND. IMODE2.EQ.'COMP')THEN
17219        IGKSID=102
17220      ELSEIF(IMODEL.EQ.'104')THEN
17221        IGKSID=104
17222      ELSEIF(IMODEL.EQ.'PBM')THEN
17223        IGKSID=104
17224      ELSEIF(IMODEL.EQ.'201')THEN
17225        IGKSID=201
17226      ELSEIF(IMODEL.EQ.'TAB' .AND. IMODE2.EQ.'132')THEN
17227        IGKSID=201
17228      ELSEIF(IMODEL.EQ.'204')THEN
17229        IGKSID=204
17230      ELSEIF(IMODEL.EQ.'MONT' .AND. IMODE2.EQ.'MG20')THEN
17231        IGKSID=204
17232      ELSEIF(IMODEL.EQ.'207')THEN
17233        IGKSID=207
17234      ELSEIF(IMODEL.EQ.'IBM' .AND. IMODE2.EQ.'PC')THEN
17235        IGKSID=207
17236      ELSEIF(IMODEL.EQ.'210')THEN
17237        IGKSID=210
17238      ELSEIF(IMODEL.EQ.'X' .AND. IMODE2.EQ.'SUN' .AND.
17239     1       IMODE3.EQ.'RLE')THEN
17240        IGKSID=214
17241      ELSEIF(IMODEL.EQ.'X' .AND. IMODE2.EQ.'GIF' .AND.
17242     1       IMODE3.EQ.'87A')THEN
17243        IGKSID=215
17244      ELSEIF(IMODEL.EQ.'X' .AND. IMODE2.EQ.'GIF' .AND.
17245     1       IMODE3.EQ.'89A')THEN
17246        IGKSID=218
17247      ELSEIF(IMODEL.EQ.'X' .AND. IMODE2.EQ.'FRAM' .AND.
17248     1       IMODE3.EQ.'BUFF')THEN
17249        IGKSID=217
17250      ELSEIF(IMODEL.EQ.'X')THEN
17251        IGKSID=210
17252      ELSEIF(IMODEL.EQ.'211')THEN
17253        IGKSID=211
17254      ELSEIF(IMODEL.EQ.'214')THEN
17255        IGKSID=214
17256      ELSEIF(IMODEL.EQ.'215')THEN
17257        IGKSID=215
17258      ELSEIF(IMODEL.EQ.'217')THEN
17259        IGKSID=217
17260      ELSEIF(IMODEL.EQ.'218')THEN
17261        IGKSID=218
17262      ENDIF
17263      IGKSWK=1
17264      CALL GOPWK(IGKSWK, IGKSID, IGKSTY)
17265      CALL GACWK(IGKSWK)
17266C
17267CCCCC CURRENTLY, DON'T DEFINE SEGMENTS.
17268CCCCC CALL GCRSG(IGKSWK)
17269C
17270C     INQUIRE AS TO CURRENT STATE
17271C
17272CCCCC NTEMP=1
17273CCCCC CALL GQOPWK(NTEMP,IERRFL,IOL,IWKID)
17274CCCCC print *,'after gqopwk: ierrfl,iol,iwkid=',ierrfl,iol,iwkid
17275CCCCC CALL GQACWK(NTEMP,IERRFL,IOL,IWKID)
17276CCCCC print *,'after gqacwk: ierrfl,iol,iwkid=',ierrfl,iol,iwkid
17277C
17278#endif
17279      GOTO9000
17280C
17281C               ******************************************************
17282C               **  STEP 120--                                      **
17283C               **  TREAT THE GD                     DRIVER         **
17284C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
17285C               **  1) JPEG                                         **
17286C               **  2) PNG                                          **
17287C               **  3) WBMP                                         **
17288C               **  4) GIF                                          **
17289C               **  5) TIFF ?                                       **
17290C               **  6) BMP                                          **
17291C               **  7) WEBP                                         **
17292C               ******************************************************
17293C
1729412000 CONTINUE
17295C
1729612010 CONTINUE
17297      ITYPE=1
17298      GOTO12090
17299C
1730012020 CONTINUE
17301      ITYPE=2
17302      GOTO12090
17303C
1730412030 CONTINUE
17305      ITYPE=3
17306      GOTO12090
17307C
1730812040 CONTINUE
17309      ITYPE=4
17310      GOTO12090
17311C
1731212050 CONTINUE
17313      ITYPE=5
17314      GOTO12090
17315C
1731612060 CONTINUE
17317      ITYPE=6
17318      GOTO12090
17319C
1732012070 CONTINUE
17321      ITYPE=7
17322      GOTO12090
17323C
1732412080 CONTINUE
17325      ITYPE=8
17326      GOTO12090
17327C
1732812090 CONTINUE
17329C
17330#ifdef HAVE_GD
17331      CALL GDINIT(ITYPE)
17332#endif
17333      GOTO9000
17334C
17335C               ******************************************************
17336C               **  STEP 130--                                      **
17337C               **  TREAT THE ABSOFT                 DRIVER         **
17338C               ******************************************************
17339C
1734013000 CONTINUE
17341#ifdef HAVE_ABSOFT
17342      XPIXMN=100.0
17343      XPIXMX=700.0
17344      YPIXMN=100.0
17345      YPIXMX=550.0
17346      CALL MIGSetup(XPIXMN,XPIXMX,YPIXMN,YPIXMX,ACOORD)
17347      AXMN=0.0
17348      AXMX=100.0
17349      AYMN=0.0
17350      AYMX=100.0
17351      IDISP=0
17352      CALL DefineCoord(AXMN,AYMN,AXMX,AYMX,IDISP,BCOORD)
17353#endif
17354      GOTO9000
17355C
17356C               ******************************************************
17357C               **  STEP 135--                                      **
17358C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
17359C               ******************************************************
17360C
17361C  STEP 1: INITIALIZE DEVICE
17362C  STEP 2: DEFINE COLOR MAP
17363C
1736413500 CONTINUE
17365COLD  CALL aqtInit()
17366C
17367COLD  DO13510I=1,MAXCLR
17368COLD    IVAL1=IRED(I)
17369COLD    VAL1=REAL(IVAL1)/255.0
17370COLD    IVAL2=IGREEN(I)
17371COLD    VAL2=REAL(IVAL2)/255.0
17372COLD    IVAL3=IBLUE(I)
17373COLD    VAL3=REAL(IVAL3)/255.0
17374COLD    IENTRY=I-1
17375COLD    CALL aqtSetColormapEntry(IENTRY,VAL1,VAL2,VAL3)
17376C13510 CONTINUE
17377C
17378      NPLOT=1
17379#ifdef HAVE_AQUA
17380      CALL aqinit(NPLOT,INT(ANUMHP+0.5),INT(ANUMVP+0.5),IRED,IGREEN,
17381     1            IBLUE,MAXCLR)
17382#endif
17383      GOTO9000
17384C
17385C               ******************************************************
17386C               **  STEP 150--                                      **
17387C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
17388C               **  TWO CASES:                                      **
17389C               **  1) DEVICE xxx LATEX INDEPENDENT                 **
17390C               **     TREAT THE LATEX GRAPH AS AN INDEPENDENT.     **
17391C               **     PREAMBLE.                                    **
17392C               **  2) DEVICE xxx LATEX                             **
17393C               **     TREAT THE LATEX GRAPH AS SOMETHING TO BE     **
17394C               **     INCORPORATED INTO LARGER LATEX DOCUMENT.     **
17395C               **     IN THIS CASE, DO NOTHING.                    **
17396C               ******************************************************
17397C
1739815000 CONTINUE
17399C
17400      IF(IMODEL.EQ.'STAN')THEN
17401C
17402        ICSTR=' '
17403        IF(ILATHE.EQ.'NULL')THEN
17404C
17405          ICSTR(1:1)=IBASLC
17406          ICSTR(2:29)='documentclass[12pt]{article}'
17407          NCSTR=29
17408          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17409C
17410          ICSTR(1:1)=' '
17411          NCSTR=1
17412          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17413C
17414          ICSTR(1:1)=IBASLC
17415          ICSTR(2:99)='usepackage{epsfig}'
17416          NCSTR=19
17417          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17418C
17419          ICSTR(1:1)=IBASLC
17420          ICSTR(2:23)='usepackage{epic,eepic}'
17421          NCSTR=23
17422          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17423C
17424          ICSTR(1:1)=IBASLC
17425          ICSTR(2:27)='usepackage{graphics,color}'
17426          NCSTR=27
17427          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17428C
17429          ICSTR(1:1)=' '
17430          NCSTR=1
17431          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17432C
17433          ICSTR(1:1)=IBASLC
17434          ICSTR(2:30)='setlength{ textwidth}{6.25in}'
17435          ICSTR(12:12)=IBASLC
17436          NCSTR=30
17437          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17438C
17439          ICSTR(1:1)=IBASLC
17440          ICSTR(2:28)='setlength{ textheight}{9in}'
17441          ICSTR(12:12)=IBASLC
17442          NCSTR=28
17443          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17444C
17445          ICSTR(1:1)=IBASLC
17446          ICSTR(2:34)='setlength{ oddsidemargin}{0.25in}'
17447          ICSTR(12:12)=IBASLC
17448          NCSTR=34
17449          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17450C
17451          ICSTR(1:1)=IBASLC
17452          ICSTR(2:32)='setlength{ evensidemargin}{0in}'
17453          ICSTR(12:12)=IBASLC
17454          NCSTR=32
17455          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17456C
17457          ICSTR(1:1)=IBASLC
17458          ICSTR(2:30)='setlength{ headheight}{0.5in}'
17459          ICSTR(12:12)=IBASLC
17460          NCSTR=30
17461          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17462C
17463          ICSTR(1:1)=IBASLC
17464          ICSTR(2:28)='setlength{ headsep}{0.5in}'
17465          ICSTR(12:12)=IBASLC
17466          NCSTR=28
17467          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17468C
17469          ICSTR(1:1)=IBASLC
17470          ICSTR(2:28)='setlength{ topmargin}{-1in}'
17471          ICSTR(12:12)=IBASLC
17472          NCSTR=28
17473          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17474C
17475          ICSTR(1:1)=IBASLC
17476          ICSTR(2:27)='setlength{ parindent}{0in}'
17477          ICSTR(12:12)=IBASLC
17478          NCSTR=27
17479          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17480C
17481          ICSTR(1:1)=IBASLC
17482          ICSTR(2:26)='setlength{ parskip}{10pt}'
17483          ICSTR(12:12)=IBASLC
17484          NCSTR=26
17485          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17486C
17487          ICSTR(1:1)=IBASLC
17488          ICSTR(2:30)='setlength{ textfloatsep}{4ex}'
17489          ICSTR(12:12)=IBASLC
17490          NCSTR=30
17491          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17492C
17493          ICSTR(1:1)=IBASLC
17494          ICSTR(2:31)='addtolength{ footskip}{0.25in}'
17495          ICSTR(14:14)=IBASLC
17496          NCSTR=31
17497          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17498C
17499          ICSTR(1:1)=IBASLC
17500          ICSTR(2:17)='overfullrule=0pt'
17501          NCSTR=17
17502          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17503C
17504          ICSTR(1:1)=IBASLC
17505          ICSTR(2:18)='baselineskip=12pt'
17506          NCSTR=18
17507          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17508C
17509          ICSTR(1:1)=' '
17510          NCSTR=1
17511          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17512C
17513CCCCC     PGRAPHIC AND LGRAPHIC FOR IMPORTING EXTERNAL
17514CCCCC     POSTSCRIPT FILES.  NOT RELEVANT IN THIS CONTEXT,
17515CCCCC     SO COMMENT OUT FOR NOW.
17516C
17517CCCCC     ICSTR(1:1)=IBASLC
17518CCCCC     ICSTR(2:12)='newcommand{'
17519CCCCC     ICSTR(13:13)=IBASLC
17520CCCCC     ICSTR(14:26)='PGRAPHIC}[1]{'
17521CCCCC     ICSTR(27:27)=IBASLC
17522CCCCC     ICSTR(28:43)='begin{figure}[h]'
17523CCCCC     NCSTR=43
17524CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17525C
17526CCCCC     ICSTR(1:1)=IBASLC
17527CCCCC     ICSTR(2:28)='epsfig{file=#1,width=6.0in}'
17528CCCCC     NCSTR=28
17529CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17530C
17531CCCCC     ICSTR(1:1)=IBASLC
17532CCCCC     ICSTR(2:13)='end{figure}}'
17533CCCCC     NCSTR=13
17534CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17535C
17536CCCCC     ICSTR(1:1)=IBASLC
17537CCCCC     ICSTR(2:12)='newcommand{'
17538CCCCC     ICSTR(13:13)=IBASLC
17539CCCCC     ICSTR(14:26)='LGRAPHIC}[1]{'
17540CCCCC     ICSTR(27:27)=IBASLC
17541CCCCC     ICSTR(28:43)='begin{figure}[h]'
17542CCCCC     NCSTR=43
17543CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17544C
17545CCCCC     ICSTR(1:1)=IBASLC
17546CCCCC     ICSTR(2:38)='epsfig{file=#1,angle=-90,width=6.0in}'
17547CCCCC     NCSTR=38
17548CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17549C
17550CCCCC     ICSTR(1:1)=IBASLC
17551CCCCC     ICSTR(2:13)='end{figure}}'
17552CCCCC     NCSTR=13
17553CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17554C
17555CCCCC     ICSTR(1:1)=' '
17556CCCCC     NCSTR=1
17557CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17558C
17559CCCCC     ICSTR(1:1)=IBASLC
17560CCCCC     ICSTR(2:16)='begin{verbatim}'
17561CCCCC     NCSTR=16
17562CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17563C
17564CCCCC     ICSTR(1:1)=' '
17565CCCCC     NCSTR=1
17566CCCCC     CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17567C
17568        ELSE
17569          IOUNI1=IST1NU
17570          IFILE1=ILATHE
17571          ISTAT1='OLD'
17572          IFORM1='FORMATTED'
17573          IACCE1='SEQUENTIAL'
17574          IPROT1='READONLY'
17575          ICURS1='CLOSED'
17576          ISUBN0='CAPT'
17577          IERRF1='NO'
17578C
17579          IREWI1='ON'
17580          CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,
17581     1                IPROT1,ICURS1,
17582     1                IREWI1,ISUBN0,IERRF1,IBUGG4,ISUBRO,IERROR)
17583          IF(IERRF1.EQ.'YES')GOTO9000
17584C
17585C  NOW LOOP THROUGH FILE (ASSUME MAXIMUM OF 1,000 LINES).
17586C
17587          DO15301I=1,1000
17588            IATEMP=' '
17589            READ(IOUNI1,15392,END=15399,ERR=15399)IATEMP
1759015392       FORMAT(A240)
17591            ILAST=1
17592            DO15410J=240,1,-1
17593              IF(IATEMP(J:J).NE.' ')THEN
17594                ILAST=J
17595                GOTO15419
17596              ENDIF
1759715410       CONTINUE
1759815419       CONTINUE
17599            ICSTR(1:ILAST)=IATEMP(1:ILAST)
17600            NCSTR=ILAST
17601            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
1760215301     CONTINUE
1760315399     CONTINUE
17604          IENDF1='OFF'
17605          IREWI1='ON'
17606          CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,
17607     1                IPROT1,ICURS1,IENDF1,IREWI1,
17608     1                ISUBN0,IERRF1,IBUGG4,ISUBRO,IERROR)
17609          IF(IERRF1.EQ.'YES')GOTO9000
17610        ENDIF
17611C
17612        ICSTR(1:1)=IBASLC
17613        ICSTR(2:16)='begin{document}'
17614        NCSTR=16
17615        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17616C
17617        ICSTR(1:1)=' '
17618        NCSTR=1
17619        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17620C
17621      ELSE
17622        ICSTR(1:1)=IBASLC
17623        ICSTR(2:14)='end{verbatim}'
17624        NCSTR=14
17625        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17626C
17627      ENDIF
17628C
17629C  DEFINE GRAY SCALE COLORS
17630C
17631      IF(ILATCO.EQ.'ON')THEN
17632        NCHTOT=5
17633        NCHDEC=3
17634        DO15110I=0,9
17635          ICSTR(1:1)=IBASLC
17636          ICSTR(2:25)='definecolor{G   }{gray}{'
17637          NCSTR=25
17638          WRITE(ICSTR(15:15),'(I1)')I
17639          ACOL=REAL(I)/100.0
17640          CALL GRTRRE(ACOL,NCHTOT,NCHDEC,ICSTR,NCSTR)
17641          NCSTR=NCSTR+1
17642          ICSTR(NCSTR:NCSTR)='}'
17643          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
1764415110   CONTINUE
17645        DO15120I=10,99
17646          ICSTR(1:1)=IBASLC
17647          ICSTR(2:25)='definecolor{G   }{gray}{'
17648          NCSTR=25
17649          WRITE(ICSTR(15:16),'(I2)')I
17650          ACOL=REAL(I)/100.0
17651          CALL GRTRRE(ACOL,NCHTOT,NCHDEC,ICSTR,NCSTR)
17652          NCSTR=NCSTR+1
17653          ICSTR(NCSTR:NCSTR)='}'
17654          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
1765515120   CONTINUE
17656        ICSTR(1:1)=IBASLC
17657        ICSTR(2:29)='definecolor{G100}{gray}{1.0}'
17658        NCSTR=29
17659        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17660C
17661C  IF COLOR SWITCH ON, DEFINE COLORS BASED ON RGB VALUES
17662C
17663        ICSTR(1:1)=IBASLC
17664        ICSTR(2:24)='definecolor{    }{rgb}{'
17665        NCSTR=24
17666        ICSTR(14:17)='WHIT'
17667        ARED=1.0
17668        AGREEN=1.0
17669        ABLUE=1.0
17670        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17671        NCSTR=NCSTR+1
17672        ICSTR(NCSTR:NCSTR)=','
17673        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17674        NCSTR=NCSTR+1
17675        ICSTR(NCSTR:NCSTR)=','
17676        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
17677        NCSTR=NCSTR+1
17678        ICSTR(NCSTR:NCSTR)='}'
17679        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17680C
17681        ICSTR(1:1)=IBASLC
17682        ICSTR(2:24)='definecolor{    }{rgb}{'
17683        NCSTR=24
17684        ICSTR(14:17)='BLAC'
17685        ARED=0.0
17686        AGREEN=0.0
17687        ABLUE=0.0
17688        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17689        NCSTR=NCSTR+1
17690        ICSTR(NCSTR:NCSTR)=','
17691        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17692        NCSTR=NCSTR+1
17693        ICSTR(NCSTR:NCSTR)=','
17694        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
17695        NCSTR=NCSTR+1
17696        ICSTR(NCSTR:NCSTR)='}'
17697        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17698C
17699        ICSTR(1:1)=IBASLC
17700        ICSTR(2:24)='definecolor{    }{rgb}{'
17701        NCSTR=24
17702        ICSTR(14:17)='RED '
17703        ARED=1.0
17704        AGREEN=0.0
17705        ABLUE=0.0
17706        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17707        NCSTR=NCSTR+1
17708        ICSTR(NCSTR:NCSTR)=','
17709        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17710        NCSTR=NCSTR+1
17711        ICSTR(NCSTR:NCSTR)=','
17712        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
17713        NCSTR=NCSTR+1
17714        ICSTR(NCSTR:NCSTR)='}'
17715        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17716C
17717        ICSTR(1:1)=IBASLC
17718        ICSTR(2:24)='definecolor{    }{rgb}{'
17719        NCSTR=24
17720        ICSTR(14:17)='BLUE'
17721        ARED=0.0
17722        AGREEN=0.0
17723        ABLUE=1.0
17724        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17725        NCSTR=NCSTR+1
17726        ICSTR(NCSTR:NCSTR)=','
17727        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17728        NCSTR=NCSTR+1
17729        ICSTR(NCSTR:NCSTR)=','
17730        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
17731        NCSTR=NCSTR+1
17732        ICSTR(NCSTR:NCSTR)='}'
17733        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17734C
17735        ICSTR(1:1)=IBASLC
17736        ICSTR(2:24)='definecolor{    }{rgb}{'
17737        NCSTR=24
17738        ICSTR(14:17)='GREE'
17739        ARED=0.0
17740        AGREEN=1.0
17741        ABLUE=0.0
17742        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17743        NCSTR=NCSTR+1
17744        ICSTR(NCSTR:NCSTR)=','
17745        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17746        NCSTR=NCSTR+1
17747        ICSTR(NCSTR:NCSTR)=','
17748        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
17749        NCSTR=NCSTR+1
17750        ICSTR(NCSTR:NCSTR)='}'
17751        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17752C
17753        ICSTR(1:1)=IBASLC
17754        ICSTR(2:24)='definecolor{    }{rgb}{'
17755        NCSTR=24
17756        ICSTR(14:17)='MAGE'
17757        ARED=1.0
17758        AGREEN=0.0
17759        ABLUE=1.0
17760        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17761        NCSTR=NCSTR+1
17762        ICSTR(NCSTR:NCSTR)=','
17763        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17764        NCSTR=NCSTR+1
17765        ICSTR(NCSTR:NCSTR)=','
17766        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
17767        NCSTR=NCSTR+1
17768        ICSTR(NCSTR:NCSTR)='}'
17769        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17770C
17771        ICSTR(1:1)=IBASLC
17772        ICSTR(2:24)='definecolor{    }{rgb}{'
17773        NCSTR=24
17774        ICSTR(14:17)='ORAN'
17775        ARED=1.0
17776        AGREEN=165.0/255.0
17777        ABLUE=0.0
17778        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17779        NCSTR=NCSTR+1
17780        ICSTR(NCSTR:NCSTR)=','
17781        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17782        NCSTR=NCSTR+1
17783        ICSTR(NCSTR:NCSTR)=','
17784        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
17785        NCSTR=NCSTR+1
17786        ICSTR(NCSTR:NCSTR)='}'
17787        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17788C
17789        ICSTR(1:1)=IBASLC
17790        ICSTR(2:24)='definecolor{    }{rgb}{'
17791        NCSTR=24
17792        ICSTR(14:17)='CYAN'
17793        ARED=0.0
17794        AGREEN=1.0
17795        ABLUE=1.0
17796        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17797        NCSTR=NCSTR+1
17798        ICSTR(NCSTR:NCSTR)=','
17799        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17800        NCSTR=NCSTR+1
17801        ICSTR(NCSTR:NCSTR)=','
17802        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
17803        NCSTR=NCSTR+1
17804        ICSTR(NCSTR:NCSTR)='}'
17805        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17806C
17807        ICSTR(1:1)=IBASLC
17808        ICSTR(2:24)='definecolor{    }{rgb}{'
17809        NCSTR=24
17810        ICSTR(14:17)='YELL'
17811        ARED=1.0
17812        AGREEN=1.0
17813        ABLUE=0.0
17814        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17815        NCSTR=NCSTR+1
17816        ICSTR(NCSTR:NCSTR)=','
17817        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17818        NCSTR=NCSTR+1
17819        ICSTR(NCSTR:NCSTR)=','
17820        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
17821        NCSTR=NCSTR+1
17822        ICSTR(NCSTR:NCSTR)='}'
17823        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17824C
17825        ICSTR(1:1)=IBASLC
17826        ICSTR(2:24)='definecolor{    }{rgb}{'
17827        NCSTR=24
17828        ICSTR(14:17)='YGRE'
17829        ARED=154.0/255.0
17830        AGREEN=205.0/255.0
17831        ABLUE=50.0/255.0
17832        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17833        NCSTR=NCSTR+1
17834        ICSTR(NCSTR:NCSTR)=','
17835        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17836        NCSTR=NCSTR+1
17837        ICSTR(NCSTR:NCSTR)=','
17838        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
17839        NCSTR=NCSTR+1
17840        ICSTR(NCSTR:NCSTR)='}'
17841        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17842C
17843        ICSTR(1:1)=IBASLC
17844        ICSTR(2:24)='definecolor{    }{rgb}{'
17845        NCSTR=24
17846        ICSTR(14:17)='DGRE'
17847        ARED=0.0/255.0
17848        AGREEN=100.0/255.0
17849        ABLUE=0.0/255.0
17850        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17851        NCSTR=NCSTR+1
17852        ICSTR(NCSTR:NCSTR)=','
17853        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17854        NCSTR=NCSTR+1
17855        ICSTR(NCSTR:NCSTR)=','
17856        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
17857        NCSTR=NCSTR+1
17858        ICSTR(NCSTR:NCSTR)='}'
17859        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17860C
17861        ICSTR(1:1)=IBASLC
17862        ICSTR(2:24)='definecolor{    }{rgb}{'
17863        NCSTR=24
17864        ICSTR(14:17)='LBLU'
17865        ARED=173.0/255.0
17866        AGREEN=216.0/255.0
17867        ABLUE=230.0/255.0
17868        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17869        NCSTR=NCSTR+1
17870        ICSTR(NCSTR:NCSTR)=','
17871        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17872        NCSTR=NCSTR+1
17873        ICSTR(NCSTR:NCSTR)=','
17874        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
17875        NCSTR=NCSTR+1
17876        ICSTR(NCSTR:NCSTR)='}'
17877        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17878C
17879        ICSTR(1:1)=IBASLC
17880        ICSTR(2:24)='definecolor{    }{rgb}{'
17881        NCSTR=24
17882        ICSTR(14:17)='VBLU'
17883        ARED=138.0/255.0
17884        AGREEN=43.0/255.0
17885        ABLUE=226.0/255.0
17886        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17887        NCSTR=NCSTR+1
17888        ICSTR(NCSTR:NCSTR)=','
17889        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17890        NCSTR=NCSTR+1
17891        ICSTR(NCSTR:NCSTR)=','
17892        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
17893        NCSTR=NCSTR+1
17894        ICSTR(NCSTR:NCSTR)='}'
17895        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17896C
17897        ICSTR(1:1)=IBASLC
17898        ICSTR(2:24)='definecolor{    }{rgb}{'
17899        NCSTR=24
17900        ICSTR(14:17)='VRED'
17901        ARED=208.0/255.0
17902        AGREEN=32.0/255.0
17903        ABLUE=144.0/255.0
17904        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17905        NCSTR=NCSTR+1
17906        ICSTR(NCSTR:NCSTR)=','
17907        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17908        NCSTR=NCSTR+1
17909        ICSTR(NCSTR:NCSTR)=','
17910        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
17911        NCSTR=NCSTR+1
17912        ICSTR(NCSTR:NCSTR)='}'
17913        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17914C
17915        ICSTR(1:1)=IBASLC
17916        ICSTR(2:24)='definecolor{    }{rgb}{'
17917        NCSTR=24
17918        ICSTR(14:17)='DGRE'
17919        ARED=47.0/255.0
17920        AGREEN=79.0/255.0
17921        ABLUE=79.0/255.0
17922        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17923        NCSTR=NCSTR+1
17924        ICSTR(NCSTR:NCSTR)=','
17925        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17926        NCSTR=NCSTR+1
17927        ICSTR(NCSTR:NCSTR)=','
17928        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
17929        NCSTR=NCSTR+1
17930        ICSTR(NCSTR:NCSTR)='}'
17931        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17932C
17933        ICSTR(1:1)=IBASLC
17934        ICSTR(2:24)='definecolor{    }{rgb}{'
17935        NCSTR=24
17936        ICSTR(14:17)='LGRE'
17937        ARED=211.0/255.0
17938        AGREEN=211.0/255.0
17939        ABLUE=211.0/255.0
17940        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17941        NCSTR=NCSTR+1
17942        ICSTR(NCSTR:NCSTR)=','
17943        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17944        NCSTR=NCSTR+1
17945        ICSTR(NCSTR:NCSTR)=','
17946        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
17947        NCSTR=NCSTR+1
17948        ICSTR(NCSTR:NCSTR)='}'
17949        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17950C
17951        ICSTR(1:1)=IBASLC
17952        ICSTR(2:24)='definecolor{    }{rgb}{'
17953        NCSTR=24
17954        ICSTR(14:17)='AQUA'
17955        ARED=127.0/255.0
17956        AGREEN=255.0/255.0
17957        ABLUE=212.0/255.0
17958        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17959        NCSTR=NCSTR+1
17960        ICSTR(NCSTR:NCSTR)=','
17961        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17962        NCSTR=NCSTR+1
17963        ICSTR(NCSTR:NCSTR)=','
17964        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
17965        NCSTR=NCSTR+1
17966        ICSTR(NCSTR:NCSTR)='}'
17967        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17968C
17969        ICSTR(1:1)=IBASLC
17970        ICSTR(2:24)='definecolor{    }{rgb}{'
17971        NCSTR=24
17972        ICSTR(14:17)='BROW'
17973        ARED=165.0/255.0
17974        AGREEN=42.0/255.0
17975        ABLUE=42.0/255.0
17976        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17977        NCSTR=NCSTR+1
17978        ICSTR(NCSTR:NCSTR)=','
17979        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17980        NCSTR=NCSTR+1
17981        ICSTR(NCSTR:NCSTR)=','
17982        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
17983        NCSTR=NCSTR+1
17984        ICSTR(NCSTR:NCSTR)='}'
17985        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
17986C
17987        ICSTR(1:1)=IBASLC
17988        ICSTR(2:24)='definecolor{    }{rgb}{'
17989        NCSTR=24
17990        ICSTR(14:17)='CABL'
17991        ARED=95.0/255.0
17992        AGREEN=158.0/255.0
17993        ABLUE=160.0/255.0
17994        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
17995        NCSTR=NCSTR+1
17996        ICSTR(NCSTR:NCSTR)=','
17997        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
17998        NCSTR=NCSTR+1
17999        ICSTR(NCSTR:NCSTR)=','
18000        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18001        NCSTR=NCSTR+1
18002        ICSTR(NCSTR:NCSTR)='}'
18003        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18004C
18005        ICSTR(1:1)=IBASLC
18006        ICSTR(2:24)='definecolor{    }{rgb}{'
18007        NCSTR=24
18008        ICSTR(14:17)='CORA'
18009        ARED=255.0/255.0
18010        AGREEN=127.0/255.0
18011        ABLUE=80.0/255.0
18012        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18013        NCSTR=NCSTR+1
18014        ICSTR(NCSTR:NCSTR)=','
18015        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18016        NCSTR=NCSTR+1
18017        ICSTR(NCSTR:NCSTR)=','
18018        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18019        NCSTR=NCSTR+1
18020        ICSTR(NCSTR:NCSTR)='}'
18021        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18022C
18023        ICSTR(1:1)=IBASLC
18024        ICSTR(2:24)='definecolor{    }{rgb}{'
18025        NCSTR=24
18026        ICSTR(14:17)='CBLU'
18027        ARED=100.0/255.0
18028        AGREEN=149.0/255.0
18029        ABLUE=237.0/255.0
18030        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18031        NCSTR=NCSTR+1
18032        ICSTR(NCSTR:NCSTR)=','
18033        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18034        NCSTR=NCSTR+1
18035        ICSTR(NCSTR:NCSTR)=','
18036        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18037        NCSTR=NCSTR+1
18038        ICSTR(NCSTR:NCSTR)='}'
18039        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18040C
18041        ICSTR(1:1)=IBASLC
18042        ICSTR(2:24)='definecolor{    }{rgb}{'
18043        NCSTR=24
18044        ICSTR(14:17)='DOGR'
18045        ARED=85.0/255.0
18046        AGREEN=107.0/255.0
18047        ABLUE=47.0/255.0
18048        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18049        NCSTR=NCSTR+1
18050        ICSTR(NCSTR:NCSTR)=','
18051        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18052        NCSTR=NCSTR+1
18053        ICSTR(NCSTR:NCSTR)=','
18054        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18055        NCSTR=NCSTR+1
18056        ICSTR(NCSTR:NCSTR)='}'
18057        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18058C
18059        ICSTR(1:1)=IBASLC
18060        ICSTR(2:24)='definecolor{    }{rgb}{'
18061        NCSTR=24
18062        ICSTR(14:17)='DORC'
18063        ARED=153.0/255.0
18064        AGREEN=50.0/255.0
18065        ABLUE=204.0/255.0
18066        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18067        NCSTR=NCSTR+1
18068        ICSTR(NCSTR:NCSTR)=','
18069        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18070        NCSTR=NCSTR+1
18071        ICSTR(NCSTR:NCSTR)=','
18072        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18073        NCSTR=NCSTR+1
18074        ICSTR(NCSTR:NCSTR)='}'
18075        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18076C
18077        ICSTR(1:1)=IBASLC
18078        ICSTR(2:24)='definecolor{    }{rgb}{'
18079        NCSTR=24
18080        ICSTR(14:17)='DSBL'
18081        ARED=72.0/255.0
18082        AGREEN=61.0/255.0
18083        ABLUE=139.0/255.0
18084        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18085        NCSTR=NCSTR+1
18086        ICSTR(NCSTR:NCSTR)=','
18087        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18088        NCSTR=NCSTR+1
18089        ICSTR(NCSTR:NCSTR)=','
18090        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18091        NCSTR=NCSTR+1
18092        ICSTR(NCSTR:NCSTR)='}'
18093        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18094C
18095        ICSTR(1:1)=IBASLC
18096        ICSTR(2:24)='definecolor{    }{rgb}{'
18097        NCSTR=24
18098        ICSTR(14:17)='DTUR'
18099        ARED=0.0/255.0
18100        AGREEN=206.0/255.0
18101        ABLUE=209.0/255.0
18102        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18103        NCSTR=NCSTR+1
18104        ICSTR(NCSTR:NCSTR)=','
18105        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18106        NCSTR=NCSTR+1
18107        ICSTR(NCSTR:NCSTR)=','
18108        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18109        NCSTR=NCSTR+1
18110        ICSTR(NCSTR:NCSTR)='}'
18111        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18112C
18113        ICSTR(1:1)=IBASLC
18114        ICSTR(2:24)='definecolor{    }{rgb}{'
18115        NCSTR=24
18116        ICSTR(14:17)='FIRE'
18117        ARED=178.0/255.0
18118        AGREEN=34.0/255.0
18119        ABLUE=34.0/255.0
18120        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18121        NCSTR=NCSTR+1
18122        ICSTR(NCSTR:NCSTR)=','
18123        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18124        NCSTR=NCSTR+1
18125        ICSTR(NCSTR:NCSTR)=','
18126        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18127        NCSTR=NCSTR+1
18128        ICSTR(NCSTR:NCSTR)='}'
18129        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18130C
18131        ICSTR(1:1)=IBASLC
18132        ICSTR(2:24)='definecolor{    }{rgb}{'
18133        NCSTR=24
18134        ICSTR(14:17)='FGRE'
18135        ARED=34.0/255.0
18136        AGREEN=139.0/255.0
18137        ABLUE=34.0/255.0
18138        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18139        NCSTR=NCSTR+1
18140        ICSTR(NCSTR:NCSTR)=','
18141        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18142        NCSTR=NCSTR+1
18143        ICSTR(NCSTR:NCSTR)=','
18144        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18145        NCSTR=NCSTR+1
18146        ICSTR(NCSTR:NCSTR)='}'
18147        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18148C
18149        ICSTR(1:1)=IBASLC
18150        ICSTR(2:24)='definecolor{    }{rgb}{'
18151        NCSTR=24
18152        ICSTR(14:17)='GOLD'
18153        ARED=255.0/255.0
18154        AGREEN=215.0/255.0
18155        ABLUE=0.0/255.0
18156        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18157        NCSTR=NCSTR+1
18158        ICSTR(NCSTR:NCSTR)=','
18159        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18160        NCSTR=NCSTR+1
18161        ICSTR(NCSTR:NCSTR)=','
18162        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18163        NCSTR=NCSTR+1
18164        ICSTR(NCSTR:NCSTR)='}'
18165        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18166C
18167        ICSTR(1:1)=IBASLC
18168        ICSTR(2:24)='definecolor{    }{rgb}{'
18169        NCSTR=24
18170        ICSTR(14:17)='GLDR'
18171        ARED=218.0/255.0
18172        AGREEN=165.0/255.0
18173        ABLUE=32.0/255.0
18174        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18175        NCSTR=NCSTR+1
18176        ICSTR(NCSTR:NCSTR)=','
18177        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18178        NCSTR=NCSTR+1
18179        ICSTR(NCSTR:NCSTR)=','
18180        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18181        NCSTR=NCSTR+1
18182        ICSTR(NCSTR:NCSTR)='}'
18183        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18184C
18185        ICSTR(1:1)=IBASLC
18186        ICSTR(2:24)='definecolor{    }{rgb}{'
18187        NCSTR=24
18188        ICSTR(14:17)='GRAY'
18189        ARED=192.0/255.0
18190        AGREEN=192.0/255.0
18191        ABLUE=192.0/255.0
18192        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18193        NCSTR=NCSTR+1
18194        ICSTR(NCSTR:NCSTR)=','
18195        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18196        NCSTR=NCSTR+1
18197        ICSTR(NCSTR:NCSTR)=','
18198        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18199        NCSTR=NCSTR+1
18200        ICSTR(NCSTR:NCSTR)='}'
18201        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18202C
18203        ICSTR(1:1)=IBASLC
18204        ICSTR(2:24)='definecolor{    }{rgb}{'
18205        NCSTR=24
18206        ICSTR(14:17)='IRED'
18207        ARED=205.0/255.0
18208        AGREEN=92.0/255.0
18209        ABLUE=92.0/255.0
18210        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18211        NCSTR=NCSTR+1
18212        ICSTR(NCSTR:NCSTR)=','
18213        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18214        NCSTR=NCSTR+1
18215        ICSTR(NCSTR:NCSTR)=','
18216        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18217        NCSTR=NCSTR+1
18218        ICSTR(NCSTR:NCSTR)='}'
18219        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18220C
18221        ICSTR(1:1)=IBASLC
18222        ICSTR(2:24)='definecolor{    }{rgb}{'
18223        NCSTR=24
18224        ICSTR(14:17)='KHAK'
18225        ARED=240.0/255.0
18226        AGREEN=230.0/255.0
18227        ABLUE=140.0/255.0
18228        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18229        NCSTR=NCSTR+1
18230        ICSTR(NCSTR:NCSTR)=','
18231        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18232        NCSTR=NCSTR+1
18233        ICSTR(NCSTR:NCSTR)=','
18234        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18235        NCSTR=NCSTR+1
18236        ICSTR(NCSTR:NCSTR)='}'
18237        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18238C
18239        ICSTR(1:1)=IBASLC
18240        ICSTR(2:24)='definecolor{    }{rgb}{'
18241        NCSTR=24
18242        ICSTR(14:17)='DMGR'
18243        ARED=105.0/255.0
18244        AGREEN=105.0/255.0
18245        ABLUE=105.0/255.0
18246        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18247        NCSTR=NCSTR+1
18248        ICSTR(NCSTR:NCSTR)=','
18249        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18250        NCSTR=NCSTR+1
18251        ICSTR(NCSTR:NCSTR)=','
18252        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18253        NCSTR=NCSTR+1
18254        ICSTR(NCSTR:NCSTR)='}'
18255        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18256C
18257        ICSTR(1:1)=IBASLC
18258        ICSTR(2:24)='definecolor{    }{rgb}{'
18259        NCSTR=24
18260        ICSTR(14:17)='LSBL'
18261        ARED=176.0/255.0
18262        AGREEN=196.0/255.0
18263        ABLUE=222.0/255.0
18264        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18265        NCSTR=NCSTR+1
18266        ICSTR(NCSTR:NCSTR)=','
18267        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18268        NCSTR=NCSTR+1
18269        ICSTR(NCSTR:NCSTR)=','
18270        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18271        NCSTR=NCSTR+1
18272        ICSTR(NCSTR:NCSTR)='}'
18273        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18274C
18275        ICSTR(1:1)=IBASLC
18276        ICSTR(2:24)='definecolor{    }{rgb}{'
18277        NCSTR=24
18278        ICSTR(14:17)='LGRE'
18279        ARED=50.0/255.0
18280        AGREEN=205.0/255.0
18281        ABLUE=50.0/255.0
18282        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18283        NCSTR=NCSTR+1
18284        ICSTR(NCSTR:NCSTR)=','
18285        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18286        NCSTR=NCSTR+1
18287        ICSTR(NCSTR:NCSTR)=','
18288        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18289        NCSTR=NCSTR+1
18290        ICSTR(NCSTR:NCSTR)='}'
18291        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18292C
18293        ICSTR(1:1)=IBASLC
18294        ICSTR(2:24)='definecolor{    }{rgb}{'
18295        NCSTR=24
18296        ICSTR(14:17)='MARO'
18297        ARED=176.0/255.0
18298        AGREEN=48.0/255.0
18299        ABLUE=96.0/255.0
18300        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18301        NCSTR=NCSTR+1
18302        ICSTR(NCSTR:NCSTR)=','
18303        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18304        NCSTR=NCSTR+1
18305        ICSTR(NCSTR:NCSTR)=','
18306        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18307        NCSTR=NCSTR+1
18308        ICSTR(NCSTR:NCSTR)='}'
18309        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18310C
18311        ICSTR(1:1)=IBASLC
18312        ICSTR(2:24)='definecolor{    }{rgb}{'
18313        NCSTR=24
18314        ICSTR(14:17)='MAQU'
18315        ARED=102.0/255.0
18316        AGREEN=205.0/255.0
18317        ABLUE=170.0/255.0
18318        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18319        NCSTR=NCSTR+1
18320        ICSTR(NCSTR:NCSTR)=','
18321        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18322        NCSTR=NCSTR+1
18323        ICSTR(NCSTR:NCSTR)=','
18324        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18325        NCSTR=NCSTR+1
18326        ICSTR(NCSTR:NCSTR)='}'
18327        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18328C
18329        ICSTR(1:1)=IBASLC
18330        ICSTR(2:24)='definecolor{    }{rgb}{'
18331        NCSTR=24
18332        ICSTR(14:17)='MBLU'
18333        ARED=0.0/255.0
18334        AGREEN=0.0/255.0
18335        ABLUE=205.0/255.0
18336        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18337        NCSTR=NCSTR+1
18338        ICSTR(NCSTR:NCSTR)=','
18339        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18340        NCSTR=NCSTR+1
18341        ICSTR(NCSTR:NCSTR)=','
18342        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18343        NCSTR=NCSTR+1
18344        ICSTR(NCSTR:NCSTR)='}'
18345        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18346C
18347        ICSTR(1:1)=IBASLC
18348        ICSTR(2:24)='definecolor{    }{rgb}{'
18349        NCSTR=24
18350        ICSTR(14:17)='MFGR'
18351        ARED=107.0/255.0
18352        AGREEN=142.0/255.0
18353        ABLUE=35.0/255.0
18354        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18355        NCSTR=NCSTR+1
18356        ICSTR(NCSTR:NCSTR)=','
18357        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18358        NCSTR=NCSTR+1
18359        ICSTR(NCSTR:NCSTR)=','
18360        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18361        NCSTR=NCSTR+1
18362        ICSTR(NCSTR:NCSTR)='}'
18363        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18364C
18365        ICSTR(1:1)=IBASLC
18366        ICSTR(2:24)='definecolor{    }{rgb}{'
18367        NCSTR=24
18368        ICSTR(14:17)='MGLD'
18369        ARED=250.0/255.0
18370        AGREEN=250.0/255.0
18371        ABLUE=210.0/255.0
18372        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18373        NCSTR=NCSTR+1
18374        ICSTR(NCSTR:NCSTR)=','
18375        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18376        NCSTR=NCSTR+1
18377        ICSTR(NCSTR:NCSTR)=','
18378        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18379        NCSTR=NCSTR+1
18380        ICSTR(NCSTR:NCSTR)='}'
18381        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18382C
18383        ICSTR(1:1)=IBASLC
18384        ICSTR(2:24)='definecolor{    }{rgb}{'
18385        NCSTR=24
18386        ICSTR(14:17)='MORC'
18387        ARED=186.0/255.0
18388        AGREEN=85.0/255.0
18389        ABLUE=211.0/255.0
18390        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18391        NCSTR=NCSTR+1
18392        ICSTR(NCSTR:NCSTR)=','
18393        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18394        NCSTR=NCSTR+1
18395        ICSTR(NCSTR:NCSTR)=','
18396        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18397        NCSTR=NCSTR+1
18398        ICSTR(NCSTR:NCSTR)='}'
18399        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18400C
18401        ICSTR(1:1)=IBASLC
18402        ICSTR(2:24)='definecolor{    }{rgb}{'
18403        NCSTR=24
18404        ICSTR(14:17)='MSGR'
18405        ARED=60.0/255.0
18406        AGREEN=179.0/255.0
18407        ABLUE=113.0/255.0
18408        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18409        NCSTR=NCSTR+1
18410        ICSTR(NCSTR:NCSTR)=','
18411        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18412        NCSTR=NCSTR+1
18413        ICSTR(NCSTR:NCSTR)=','
18414        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18415        NCSTR=NCSTR+1
18416        ICSTR(NCSTR:NCSTR)='}'
18417        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18418C
18419        ICSTR(1:1)=IBASLC
18420        ICSTR(2:24)='definecolor{    }{rgb}{'
18421        NCSTR=24
18422        ICSTR(14:17)='MSBL'
18423        ARED=123.0/255.0
18424        AGREEN=104.0/255.0
18425        ABLUE=238.0/255.0
18426        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18427        NCSTR=NCSTR+1
18428        ICSTR(NCSTR:NCSTR)=','
18429        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18430        NCSTR=NCSTR+1
18431        ICSTR(NCSTR:NCSTR)=','
18432        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18433        NCSTR=NCSTR+1
18434        ICSTR(NCSTR:NCSTR)='}'
18435        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18436C
18437        ICSTR(1:1)=IBASLC
18438        ICSTR(2:24)='definecolor{    }{rgb}{'
18439        NCSTR=24
18440        ICSTR(14:17)='MSPG'
18441        ARED=0.0/255.0
18442        AGREEN=250.0/255.0
18443        ABLUE=154.0/255.0
18444        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18445        NCSTR=NCSTR+1
18446        ICSTR(NCSTR:NCSTR)=','
18447        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18448        NCSTR=NCSTR+1
18449        ICSTR(NCSTR:NCSTR)=','
18450        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18451        NCSTR=NCSTR+1
18452        ICSTR(NCSTR:NCSTR)='}'
18453        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18454C
18455        ICSTR(1:1)=IBASLC
18456        ICSTR(2:24)='definecolor{    }{rgb}{'
18457        NCSTR=24
18458        ICSTR(14:17)='MTUR'
18459        ARED=72.0/255.0
18460        AGREEN=209.0/255.0
18461        ABLUE=204.0/255.0
18462        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18463        NCSTR=NCSTR+1
18464        ICSTR(NCSTR:NCSTR)=','
18465        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18466        NCSTR=NCSTR+1
18467        ICSTR(NCSTR:NCSTR)=','
18468        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18469        NCSTR=NCSTR+1
18470        ICSTR(NCSTR:NCSTR)='}'
18471        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18472C
18473        ICSTR(1:1)=IBASLC
18474        ICSTR(2:24)='definecolor{    }{rgb}{'
18475        NCSTR=24
18476        ICSTR(14:17)='MVRD'
18477        ARED=199.0/255.0
18478        AGREEN=21.0/255.0
18479        ABLUE=133.0/255.0
18480        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18481        NCSTR=NCSTR+1
18482        ICSTR(NCSTR:NCSTR)=','
18483        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18484        NCSTR=NCSTR+1
18485        ICSTR(NCSTR:NCSTR)=','
18486        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18487        NCSTR=NCSTR+1
18488        ICSTR(NCSTR:NCSTR)='}'
18489        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18490C
18491        ICSTR(1:1)=IBASLC
18492        ICSTR(2:24)='definecolor{    }{rgb}{'
18493        NCSTR=24
18494        ICSTR(14:17)='MDBL'
18495        ARED=25.0/255.0
18496        AGREEN=25.0/255.0
18497        ABLUE=112.0/255.0
18498        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18499        NCSTR=NCSTR+1
18500        ICSTR(NCSTR:NCSTR)=','
18501        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18502        NCSTR=NCSTR+1
18503        ICSTR(NCSTR:NCSTR)=','
18504        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18505        NCSTR=NCSTR+1
18506        ICSTR(NCSTR:NCSTR)='}'
18507        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18508C
18509        ICSTR(1:1)=IBASLC
18510        ICSTR(2:24)='definecolor{    }{rgb}{'
18511        NCSTR=24
18512        ICSTR(14:17)='NAVY'
18513        ARED=0.0/255.0
18514        AGREEN=0.0/255.0
18515        ABLUE=128.0/255.0
18516        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18517        NCSTR=NCSTR+1
18518        ICSTR(NCSTR:NCSTR)=','
18519        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18520        NCSTR=NCSTR+1
18521        ICSTR(NCSTR:NCSTR)=','
18522        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18523        NCSTR=NCSTR+1
18524        ICSTR(NCSTR:NCSTR)='}'
18525        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18526C
18527        ICSTR(1:1)=IBASLC
18528        ICSTR(2:24)='definecolor{    }{rgb}{'
18529        NCSTR=24
18530        ICSTR(14:17)='ORED'
18531        ARED=255.0/255.0
18532        AGREEN=69.0/255.0
18533        ABLUE=0.0/255.0
18534        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18535        NCSTR=NCSTR+1
18536        ICSTR(NCSTR:NCSTR)=','
18537        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18538        NCSTR=NCSTR+1
18539        ICSTR(NCSTR:NCSTR)=','
18540        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18541        NCSTR=NCSTR+1
18542        ICSTR(NCSTR:NCSTR)='}'
18543        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18544C
18545        ICSTR(1:1)=IBASLC
18546        ICSTR(2:24)='definecolor{    }{rgb}{'
18547        NCSTR=24
18548        ICSTR(14:17)='ORCH'
18549        ARED=218.0/255.0
18550        AGREEN=112.0/255.0
18551        ABLUE=214.0/255.0
18552        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18553        NCSTR=NCSTR+1
18554        ICSTR(NCSTR:NCSTR)=','
18555        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18556        NCSTR=NCSTR+1
18557        ICSTR(NCSTR:NCSTR)=','
18558        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18559        NCSTR=NCSTR+1
18560        ICSTR(NCSTR:NCSTR)='}'
18561        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18562C
18563        ICSTR(1:1)=IBASLC
18564        ICSTR(2:24)='definecolor{    }{rgb}{'
18565        NCSTR=24
18566        ICSTR(14:17)='PGRE'
18567        ARED=152.0/255.0
18568        AGREEN=251.0/255.0
18569        ABLUE=152.0/255.0
18570        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18571        NCSTR=NCSTR+1
18572        ICSTR(NCSTR:NCSTR)=','
18573        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18574        NCSTR=NCSTR+1
18575        ICSTR(NCSTR:NCSTR)=','
18576        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18577        NCSTR=NCSTR+1
18578        ICSTR(NCSTR:NCSTR)='}'
18579        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18580C
18581        ICSTR(1:1)=IBASLC
18582        ICSTR(2:24)='definecolor{    }{rgb}{'
18583        NCSTR=24
18584        ICSTR(14:17)='PINK'
18585        ARED=255.0/255.0
18586        AGREEN=192.0/255.0
18587        ABLUE=203.0/255.0
18588        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18589        NCSTR=NCSTR+1
18590        ICSTR(NCSTR:NCSTR)=','
18591        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18592        NCSTR=NCSTR+1
18593        ICSTR(NCSTR:NCSTR)=','
18594        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18595        NCSTR=NCSTR+1
18596        ICSTR(NCSTR:NCSTR)='}'
18597        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18598C
18599        ICSTR(1:1)=IBASLC
18600        ICSTR(2:24)='definecolor{    }{rgb}{'
18601        NCSTR=24
18602        ICSTR(14:17)='PLUM'
18603        ARED=221.0/255.0
18604        AGREEN=160.0/255.0
18605        ABLUE=221.0/255.0
18606        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18607        NCSTR=NCSTR+1
18608        ICSTR(NCSTR:NCSTR)=','
18609        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18610        NCSTR=NCSTR+1
18611        ICSTR(NCSTR:NCSTR)=','
18612        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18613        NCSTR=NCSTR+1
18614        ICSTR(NCSTR:NCSTR)='}'
18615        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18616C
18617        ICSTR(1:1)=IBASLC
18618        ICSTR(2:24)='definecolor{    }{rgb}{'
18619        NCSTR=24
18620        ICSTR(14:17)='PURP'
18621        ARED=160.0/255.0
18622        AGREEN=32.0/255.0
18623        ABLUE=240.0/255.0
18624        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18625        NCSTR=NCSTR+1
18626        ICSTR(NCSTR:NCSTR)=','
18627        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18628        NCSTR=NCSTR+1
18629        ICSTR(NCSTR:NCSTR)=','
18630        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18631        NCSTR=NCSTR+1
18632        ICSTR(NCSTR:NCSTR)='}'
18633        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18634C
18635        ICSTR(1:1)=IBASLC
18636        ICSTR(2:24)='definecolor{    }{rgb}{'
18637        NCSTR=24
18638        ICSTR(14:17)='SALM'
18639        ARED=250.0/255.0
18640        AGREEN=128.0/255.0
18641        ABLUE=114.0/255.0
18642        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18643        NCSTR=NCSTR+1
18644        ICSTR(NCSTR:NCSTR)=','
18645        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18646        NCSTR=NCSTR+1
18647        ICSTR(NCSTR:NCSTR)=','
18648        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18649        NCSTR=NCSTR+1
18650        ICSTR(NCSTR:NCSTR)='}'
18651        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18652C
18653        ICSTR(1:1)=IBASLC
18654        ICSTR(2:24)='definecolor{    }{rgb}{'
18655        NCSTR=24
18656        ICSTR(14:17)='SGRE'
18657        ARED=46.0/255.0
18658        AGREEN=139.0/255.0
18659        ABLUE=87.0/255.0
18660        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18661        NCSTR=NCSTR+1
18662        ICSTR(NCSTR:NCSTR)=','
18663        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18664        NCSTR=NCSTR+1
18665        ICSTR(NCSTR:NCSTR)=','
18666        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18667        NCSTR=NCSTR+1
18668        ICSTR(NCSTR:NCSTR)='}'
18669        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18670C
18671        ICSTR(1:1)=IBASLC
18672        ICSTR(2:24)='definecolor{    }{rgb}{'
18673        NCSTR=24
18674        ICSTR(14:17)='SIEN'
18675        ARED=160.0/255.0
18676        AGREEN=82.0/255.0
18677        ABLUE=45.0/255.0
18678        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18679        NCSTR=NCSTR+1
18680        ICSTR(NCSTR:NCSTR)=','
18681        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18682        NCSTR=NCSTR+1
18683        ICSTR(NCSTR:NCSTR)=','
18684        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18685        NCSTR=NCSTR+1
18686        ICSTR(NCSTR:NCSTR)='}'
18687        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18688C
18689        ICSTR(1:1)=IBASLC
18690        ICSTR(2:24)='definecolor{    }{rgb}{'
18691        NCSTR=24
18692        ICSTR(14:17)='SKBL'
18693        ARED=135.0/255.0
18694        AGREEN=206.0/255.0
18695        ABLUE=235.0/255.0
18696        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18697        NCSTR=NCSTR+1
18698        ICSTR(NCSTR:NCSTR)=','
18699        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18700        NCSTR=NCSTR+1
18701        ICSTR(NCSTR:NCSTR)=','
18702        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18703        NCSTR=NCSTR+1
18704        ICSTR(NCSTR:NCSTR)='}'
18705        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18706C
18707        ICSTR(1:1)=IBASLC
18708        ICSTR(2:24)='definecolor{    }{rgb}{'
18709        NCSTR=24
18710        ICSTR(14:17)='SBLU'
18711        ARED=106.0/255.0
18712        AGREEN=90.0/255.0
18713        ABLUE=205.0/255.0
18714        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18715        NCSTR=NCSTR+1
18716        ICSTR(NCSTR:NCSTR)=','
18717        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18718        NCSTR=NCSTR+1
18719        ICSTR(NCSTR:NCSTR)=','
18720        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18721        NCSTR=NCSTR+1
18722        ICSTR(NCSTR:NCSTR)='}'
18723        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18724C
18725        ICSTR(1:1)=IBASLC
18726        ICSTR(2:24)='definecolor{    }{rgb}{'
18727        NCSTR=24
18728        ICSTR(14:17)='SPGR'
18729        ARED=0.0/255.0
18730        AGREEN=255.0/255.0
18731        ABLUE=127.0/255.0
18732        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18733        NCSTR=NCSTR+1
18734        ICSTR(NCSTR:NCSTR)=','
18735        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18736        NCSTR=NCSTR+1
18737        ICSTR(NCSTR:NCSTR)=','
18738        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18739        NCSTR=NCSTR+1
18740        ICSTR(NCSTR:NCSTR)='}'
18741        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18742C
18743        ICSTR(1:1)=IBASLC
18744        ICSTR(2:24)='definecolor{    }{rgb}{'
18745        NCSTR=24
18746        ICSTR(14:17)='STBL'
18747        ARED=70.0/255.0
18748        AGREEN=130.0/255.0
18749        ABLUE=180.0/255.0
18750        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18751        NCSTR=NCSTR+1
18752        ICSTR(NCSTR:NCSTR)=','
18753        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18754        NCSTR=NCSTR+1
18755        ICSTR(NCSTR:NCSTR)=','
18756        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18757        NCSTR=NCSTR+1
18758        ICSTR(NCSTR:NCSTR)='}'
18759        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18760C
18761        ICSTR(1:1)=IBASLC
18762        ICSTR(2:24)='definecolor{    }{rgb}{'
18763        NCSTR=24
18764        ICSTR(14:17)='TAN '
18765        ARED=210.0/255.0
18766        AGREEN=180.0/255.0
18767        ABLUE=140.0/255.0
18768        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18769        NCSTR=NCSTR+1
18770        ICSTR(NCSTR:NCSTR)=','
18771        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18772        NCSTR=NCSTR+1
18773        ICSTR(NCSTR:NCSTR)=','
18774        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18775        NCSTR=NCSTR+1
18776        ICSTR(NCSTR:NCSTR)='}'
18777        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18778C
18779        ICSTR(1:1)=IBASLC
18780        ICSTR(2:24)='definecolor{    }{rgb}{'
18781        NCSTR=24
18782        ICSTR(14:17)='THIS'
18783        ARED=216.0/255.0
18784        AGREEN=191.0/255.0
18785        ABLUE=216.0/255.0
18786        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18787        NCSTR=NCSTR+1
18788        ICSTR(NCSTR:NCSTR)=','
18789        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18790        NCSTR=NCSTR+1
18791        ICSTR(NCSTR:NCSTR)=','
18792        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18793        NCSTR=NCSTR+1
18794        ICSTR(NCSTR:NCSTR)='}'
18795        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18796C
18797        ICSTR(1:1)=IBASLC
18798        ICSTR(2:24)='definecolor{    }{rgb}{'
18799        NCSTR=24
18800        ICSTR(14:17)='TURQ'
18801        ARED=64.0/255.0
18802        AGREEN=224.0/255.0
18803        ABLUE=208.0/255.0
18804        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18805        NCSTR=NCSTR+1
18806        ICSTR(NCSTR:NCSTR)=','
18807        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18808        NCSTR=NCSTR+1
18809        ICSTR(NCSTR:NCSTR)=','
18810        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18811        NCSTR=NCSTR+1
18812        ICSTR(NCSTR:NCSTR)='}'
18813        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18814C
18815        ICSTR(1:1)=IBASLC
18816        ICSTR(2:24)='definecolor{    }{rgb}{'
18817        NCSTR=24
18818        ICSTR(14:17)='VIOL'
18819        ARED=238.0/255.0
18820        AGREEN=130.0/255.0
18821        ABLUE=238.0/255.0
18822        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18823        NCSTR=NCSTR+1
18824        ICSTR(NCSTR:NCSTR)=','
18825        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18826        NCSTR=NCSTR+1
18827        ICSTR(NCSTR:NCSTR)=','
18828        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18829        NCSTR=NCSTR+1
18830        ICSTR(NCSTR:NCSTR)='}'
18831        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18832C
18833        ICSTR(1:1)=IBASLC
18834        ICSTR(2:24)='definecolor{    }{rgb}{'
18835        NCSTR=24
18836        ICSTR(14:17)='WHEA'
18837        ARED=245.0/255.0
18838        AGREEN=222.0/255.0
18839        ABLUE=179.0/255.0
18840        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18841        NCSTR=NCSTR+1
18842        ICSTR(NCSTR:NCSTR)=','
18843        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18844        NCSTR=NCSTR+1
18845        ICSTR(NCSTR:NCSTR)=','
18846        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18847        NCSTR=NCSTR+1
18848        ICSTR(NCSTR:NCSTR)='}'
18849        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18850C
18851        ICSTR(1:1)=IBASLC
18852        ICSTR(2:24)='definecolor{    }{rgb}{'
18853        NCSTR=24
18854        ICSTR(14:17)='GYEL'
18855        ARED=173.0/255.0
18856        AGREEN=255.0/255.0
18857        ABLUE=47.0/255.0
18858        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18859        NCSTR=NCSTR+1
18860        ICSTR(NCSTR:NCSTR)=','
18861        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18862        NCSTR=NCSTR+1
18863        ICSTR(NCSTR:NCSTR)=','
18864        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18865        NCSTR=NCSTR+1
18866        ICSTR(NCSTR:NCSTR)='}'
18867        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18868C
18869        ICSTR(1:1)=IBASLC
18870        ICSTR(2:24)='definecolor{    }{rgb}{'
18871        NCSTR=24
18872        ICSTR(14:17)='LCYA'
18873        ARED=224.0/255.0
18874        AGREEN=255.0/255.0
18875        ABLUE=255.0/255.0
18876        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18877        NCSTR=NCSTR+1
18878        ICSTR(NCSTR:NCSTR)=','
18879        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18880        NCSTR=NCSTR+1
18881        ICSTR(NCSTR:NCSTR)=','
18882        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18883        NCSTR=NCSTR+1
18884        ICSTR(NCSTR:NCSTR)='}'
18885        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18886C
18887        ICSTR(1:1)=IBASLC
18888        ICSTR(2:24)='definecolor{    }{rgb}{'
18889        NCSTR=24
18890        ICSTR(14:17)='BLU2'
18891        ARED=0.0/255.0
18892        AGREEN=0.0/255.0
18893        ABLUE=238.0/255.0
18894        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18895        NCSTR=NCSTR+1
18896        ICSTR(NCSTR:NCSTR)=','
18897        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18898        NCSTR=NCSTR+1
18899        ICSTR(NCSTR:NCSTR)=','
18900        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18901        NCSTR=NCSTR+1
18902        ICSTR(NCSTR:NCSTR)='}'
18903        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18904C
18905        ICSTR(1:1)=IBASLC
18906        ICSTR(2:24)='definecolor{    }{rgb}{'
18907        NCSTR=24
18908        ICSTR(14:17)='BLU3'
18909        ARED=0.0/255.0
18910        AGREEN=0.0/255.0
18911        ABLUE=205.0/255.0
18912        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18913        NCSTR=NCSTR+1
18914        ICSTR(NCSTR:NCSTR)=','
18915        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18916        NCSTR=NCSTR+1
18917        ICSTR(NCSTR:NCSTR)=','
18918        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18919        NCSTR=NCSTR+1
18920        ICSTR(NCSTR:NCSTR)='}'
18921        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18922C
18923        ICSTR(1:1)=IBASLC
18924        ICSTR(2:24)='definecolor{    }{rgb}{'
18925        NCSTR=24
18926        ICSTR(14:17)='BLU4'
18927        ARED=0.0/255.0
18928        AGREEN=0.0/255.0
18929        ABLUE=139.0/255.0
18930        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18931        NCSTR=NCSTR+1
18932        ICSTR(NCSTR:NCSTR)=','
18933        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18934        NCSTR=NCSTR+1
18935        ICSTR(NCSTR:NCSTR)=','
18936        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18937        NCSTR=NCSTR+1
18938        ICSTR(NCSTR:NCSTR)='}'
18939        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18940C
18941        ICSTR(1:1)=IBASLC
18942        ICSTR(2:24)='definecolor{    }{rgb}{'
18943        NCSTR=24
18944        ICSTR(14:17)='CYA2'
18945        ARED=0.0/255.0
18946        AGREEN=238.0/255.0
18947        ABLUE=238.0/255.0
18948        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18949        NCSTR=NCSTR+1
18950        ICSTR(NCSTR:NCSTR)=','
18951        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18952        NCSTR=NCSTR+1
18953        ICSTR(NCSTR:NCSTR)=','
18954        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18955        NCSTR=NCSTR+1
18956        ICSTR(NCSTR:NCSTR)='}'
18957        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18958C
18959        ICSTR(1:1)=IBASLC
18960        ICSTR(2:24)='definecolor{    }{rgb}{'
18961        NCSTR=24
18962        ICSTR(14:17)='CYA3'
18963        ARED=0.0/255.0
18964        AGREEN=205.0/255.0
18965        ABLUE=205.0/255.0
18966        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18967        NCSTR=NCSTR+1
18968        ICSTR(NCSTR:NCSTR)=','
18969        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18970        NCSTR=NCSTR+1
18971        ICSTR(NCSTR:NCSTR)=','
18972        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18973        NCSTR=NCSTR+1
18974        ICSTR(NCSTR:NCSTR)='}'
18975        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18976C
18977        ICSTR(1:1)=IBASLC
18978        ICSTR(2:24)='definecolor{    }{rgb}{'
18979        NCSTR=24
18980        ICSTR(14:17)='CYA4'
18981        ARED=0.0/255.0
18982        AGREEN=139.0/255.0
18983        ABLUE=139.0/255.0
18984        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
18985        NCSTR=NCSTR+1
18986        ICSTR(NCSTR:NCSTR)=','
18987        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
18988        NCSTR=NCSTR+1
18989        ICSTR(NCSTR:NCSTR)=','
18990        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
18991        NCSTR=NCSTR+1
18992        ICSTR(NCSTR:NCSTR)='}'
18993        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
18994C
18995        ICSTR(1:1)=IBASLC
18996        ICSTR(2:24)='definecolor{    }{rgb}{'
18997        NCSTR=24
18998        ICSTR(14:17)='GRE2'
18999        ARED=0.0/255.0
19000        AGREEN=238.0/255.0
19001        ABLUE=0.0/255.0
19002        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
19003        NCSTR=NCSTR+1
19004        ICSTR(NCSTR:NCSTR)=','
19005        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
19006        NCSTR=NCSTR+1
19007        ICSTR(NCSTR:NCSTR)=','
19008        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
19009        NCSTR=NCSTR+1
19010        ICSTR(NCSTR:NCSTR)='}'
19011        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19012C
19013        ICSTR(1:1)=IBASLC
19014        ICSTR(2:24)='definecolor{    }{rgb}{'
19015        NCSTR=24
19016        ICSTR(14:17)='GRE3'
19017        ARED=0.0/255.0
19018        AGREEN=205.0/255.0
19019        ABLUE=0.0/255.0
19020        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
19021        NCSTR=NCSTR+1
19022        ICSTR(NCSTR:NCSTR)=','
19023        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
19024        NCSTR=NCSTR+1
19025        ICSTR(NCSTR:NCSTR)=','
19026        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
19027        NCSTR=NCSTR+1
19028        ICSTR(NCSTR:NCSTR)='}'
19029        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19030C
19031        ICSTR(1:1)=IBASLC
19032        ICSTR(2:24)='definecolor{    }{rgb}{'
19033        NCSTR=24
19034        ICSTR(14:17)='GRE4'
19035        ARED=0.0/255.0
19036        AGREEN=139.0/255.0
19037        ABLUE=0.0/255.0
19038        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
19039        NCSTR=NCSTR+1
19040        ICSTR(NCSTR:NCSTR)=','
19041        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
19042        NCSTR=NCSTR+1
19043        ICSTR(NCSTR:NCSTR)=','
19044        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
19045        NCSTR=NCSTR+1
19046        ICSTR(NCSTR:NCSTR)='}'
19047        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19048C
19049        ICSTR(1:1)=IBASLC
19050        ICSTR(2:24)='definecolor{    }{rgb}{'
19051        NCSTR=24
19052        ICSTR(14:17)='YEL2'
19053        ARED=238.0/255.0
19054        AGREEN=238.0/255.0
19055        ABLUE=0.0/255.0
19056        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
19057        NCSTR=NCSTR+1
19058        ICSTR(NCSTR:NCSTR)=','
19059        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
19060        NCSTR=NCSTR+1
19061        ICSTR(NCSTR:NCSTR)=','
19062        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
19063        NCSTR=NCSTR+1
19064        ICSTR(NCSTR:NCSTR)='}'
19065        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19066C
19067        ICSTR(1:1)=IBASLC
19068        ICSTR(2:24)='definecolor{    }{rgb}{'
19069        NCSTR=24
19070        ICSTR(14:17)='YEL3'
19071        ARED=205.0/255.0
19072        AGREEN=205.0/255.0
19073        ABLUE=0.0/255.0
19074        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
19075        NCSTR=NCSTR+1
19076        ICSTR(NCSTR:NCSTR)=','
19077        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
19078        NCSTR=NCSTR+1
19079        ICSTR(NCSTR:NCSTR)=','
19080        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
19081        NCSTR=NCSTR+1
19082        ICSTR(NCSTR:NCSTR)='}'
19083        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19084C
19085        ICSTR(1:1)=IBASLC
19086        ICSTR(2:24)='definecolor{    }{rgb}{'
19087        NCSTR=24
19088        ICSTR(14:17)='YEL4'
19089        ARED=139.0/255.0
19090        AGREEN=139.0/255.0
19091        ABLUE=0.0/255.0
19092        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
19093        NCSTR=NCSTR+1
19094        ICSTR(NCSTR:NCSTR)=','
19095        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
19096        NCSTR=NCSTR+1
19097        ICSTR(NCSTR:NCSTR)=','
19098        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
19099        NCSTR=NCSTR+1
19100        ICSTR(NCSTR:NCSTR)='}'
19101        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19102C
19103        ICSTR(1:1)=IBASLC
19104        ICSTR(2:24)='definecolor{    }{rgb}{'
19105        NCSTR=24
19106        ICSTR(14:17)='ORA2'
19107        ARED=238.0/255.0
19108        AGREEN=154.0/255.0
19109        ABLUE=0.0/255.0
19110        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
19111        NCSTR=NCSTR+1
19112        ICSTR(NCSTR:NCSTR)=','
19113        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
19114        NCSTR=NCSTR+1
19115        ICSTR(NCSTR:NCSTR)=','
19116        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
19117        NCSTR=NCSTR+1
19118        ICSTR(NCSTR:NCSTR)='}'
19119        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19120C
19121        ICSTR(1:1)=IBASLC
19122        ICSTR(2:24)='definecolor{    }{rgb}{'
19123        NCSTR=24
19124        ICSTR(14:17)='ORA3'
19125        ARED=205.0/255.0
19126        AGREEN=133.0/255.0
19127        ABLUE=0.0/255.0
19128        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
19129        NCSTR=NCSTR+1
19130        ICSTR(NCSTR:NCSTR)=','
19131        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
19132        NCSTR=NCSTR+1
19133        ICSTR(NCSTR:NCSTR)=','
19134        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
19135        NCSTR=NCSTR+1
19136        ICSTR(NCSTR:NCSTR)='}'
19137        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19138C
19139        ICSTR(1:1)=IBASLC
19140        ICSTR(2:24)='definecolor{    }{rgb}{'
19141        NCSTR=24
19142        ICSTR(14:17)='ORA4'
19143        ARED=139.0/255.0
19144        AGREEN=90.0/255.0
19145        ABLUE=0.0/255.0
19146        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
19147        NCSTR=NCSTR+1
19148        ICSTR(NCSTR:NCSTR)=','
19149        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
19150        NCSTR=NCSTR+1
19151        ICSTR(NCSTR:NCSTR)=','
19152        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
19153        NCSTR=NCSTR+1
19154        ICSTR(NCSTR:NCSTR)='}'
19155        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19156C
19157        ICSTR(1:1)=IBASLC
19158        ICSTR(2:24)='definecolor{    }{rgb}{'
19159        NCSTR=24
19160        ICSTR(14:17)='RED2'
19161        ARED=238.0/255.0
19162        AGREEN=0.0/255.0
19163        ABLUE=0.0/255.0
19164        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
19165        NCSTR=NCSTR+1
19166        ICSTR(NCSTR:NCSTR)=','
19167        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
19168        NCSTR=NCSTR+1
19169        ICSTR(NCSTR:NCSTR)=','
19170        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
19171        NCSTR=NCSTR+1
19172        ICSTR(NCSTR:NCSTR)='}'
19173        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19174C
19175        ICSTR(1:1)=IBASLC
19176        ICSTR(2:24)='definecolor{    }{rgb}{'
19177        NCSTR=24
19178        ICSTR(14:17)='RED3'
19179        ARED=205.0/255.0
19180        AGREEN=0.0/255.0
19181        ABLUE=0.0/255.0
19182        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
19183        NCSTR=NCSTR+1
19184        ICSTR(NCSTR:NCSTR)=','
19185        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
19186        NCSTR=NCSTR+1
19187        ICSTR(NCSTR:NCSTR)=','
19188        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
19189        NCSTR=NCSTR+1
19190        ICSTR(NCSTR:NCSTR)='}'
19191        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19192C
19193        ICSTR(1:1)=IBASLC
19194        ICSTR(2:24)='definecolor{    }{rgb}{'
19195        NCSTR=24
19196        ICSTR(14:17)='RED4'
19197        ARED=139.0/255.0
19198        AGREEN=0.0/255.0
19199        ABLUE=0.0/255.0
19200        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
19201        NCSTR=NCSTR+1
19202        ICSTR(NCSTR:NCSTR)=','
19203        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
19204        NCSTR=NCSTR+1
19205        ICSTR(NCSTR:NCSTR)=','
19206        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
19207        NCSTR=NCSTR+1
19208        ICSTR(NCSTR:NCSTR)='}'
19209        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19210C
19211        ICSTR(1:1)=IBASLC
19212        ICSTR(2:24)='definecolor{    }{rgb}{'
19213        NCSTR=24
19214        ICSTR(14:17)='MAG2'
19215        ARED=238.0/255.0
19216        AGREEN=0.0/255.0
19217        ABLUE=238.0/255.0
19218        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
19219        NCSTR=NCSTR+1
19220        ICSTR(NCSTR:NCSTR)=','
19221        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
19222        NCSTR=NCSTR+1
19223        ICSTR(NCSTR:NCSTR)=','
19224        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
19225        NCSTR=NCSTR+1
19226        ICSTR(NCSTR:NCSTR)='}'
19227        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19228C
19229        ICSTR(1:1)=IBASLC
19230        ICSTR(2:24)='definecolor{    }{rgb}{'
19231        NCSTR=24
19232        ICSTR(14:17)='MAG3'
19233        ARED=205.0/255.0
19234        AGREEN=0.0/255.0
19235        ABLUE=205.0/255.0
19236        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
19237        NCSTR=NCSTR+1
19238        ICSTR(NCSTR:NCSTR)=','
19239        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
19240        NCSTR=NCSTR+1
19241        ICSTR(NCSTR:NCSTR)=','
19242        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
19243        NCSTR=NCSTR+1
19244        ICSTR(NCSTR:NCSTR)='}'
19245        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19246C
19247        ICSTR(1:1)=IBASLC
19248        ICSTR(2:24)='definecolor{    }{rgb}{'
19249        NCSTR=24
19250        ICSTR(14:17)='MAG4'
19251        ARED=139.0/255.0
19252        AGREEN=0.0/255.0
19253        ABLUE=139.0/255.0
19254        CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR)
19255        NCSTR=NCSTR+1
19256        ICSTR(NCSTR:NCSTR)=','
19257        CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR)
19258        NCSTR=NCSTR+1
19259        ICSTR(NCSTR:NCSTR)=','
19260        CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR)
19261        NCSTR=NCSTR+1
19262        ICSTR(NCSTR:NCSTR)='}'
19263        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19264C
19265      ENDIF
19266C
19267      GOTO9000
19268C
19269C               ******************************************************
19270C               **  STEP 160--                                      **
19271C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
19272C               ******************************************************
19273C
1927416000 CONTINUE
19275C
19276      CALL DPCONA(34,IQUOTE)
19277      ISVGOS='ON'
19278      ISVGCN=0
19279      ISVGLN=0
19280C
19281      ICSTR(1:14)='<?xml version='
19282      ICSTR(15:15)=IQUOTE
19283      ICSTR(16:18)='1.0'
19284      ICSTR(19:19)=IQUOTE
19285      ICSTR(20:29)=' encoding='
19286      ICSTR(30:30)=IQUOTE
19287      ICSTR(31:40)='ISO-8859-1'
19288      ICSTR(41:41)=IQUOTE
19289      ICSTR(42:53)=' standalone='
19290      ICSTR(54:54)=IQUOTE
19291      ICSTR(55:56)='no'
19292      ICSTR(57:57)=IQUOTE
19293      ICSTR(58:59)='?>'
19294      NCSTR=-59
19295      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19296      ICSTR(1:21)='<!DOCTYPE svg PUBLIC '
19297      ICSTR(22:22)=IQUOTE
19298      ICSTR(23:50)='-//W3C//DTD SVG 20010904//EN'
19299      ICSTR(51:51)=IQUOTE
19300      NCSTR=-51
19301      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19302      ICSTR(1:5)='     '
19303      ICSTR(6:6)=IQUOTE
19304      ICSTR(7:50)='http://www.w3.org./TR/2001/REC-SVG-20010904/'
19305      ICSTR(51:63)='DTD/svg10.dtd'
19306      ICSTR(64:64)=IQUOTE
19307      ICSTR(65:65)='>'
19308      NCSTR=-65
19309      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19310C
19311      IF(ISVGSS(1:3).EQ.'EXT')THEN
19312        NCSTR=22
19313        ICSTR(1:NCSTR)='<?xml-stylesheet href='
19314        NCSTR=-NCSTR
19315        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19316        NCSTR=1
19317        ICSTR(NCSTR:NCSTR)=IQUOTE
19318        NCTEMP=1
19319        DO16001I=80,1,-1
19320          NCTEMP=I
19321          IF(ISVGSN(I:I).NE.' ')GOTO16003
1932216001   CONTINUE
1932316003   CONTINUE
19324        NCSTR=NCSTR+1
19325        ICSTR(NCSTR:NCSTR+NCTEMP-1)=ISVGSN(1:NCTEMP)
19326        NCSTR=NCSTR+NCTEMP
19327        ICSTR(NCSTR:NCSTR)=IQUOTE
19328        NCSTR=-NCSTR
19329        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19330        NCSTR=22
19331        ICSTR(1:NCSTR)='                 type='
19332        NCSTR=NCSTR+1
19333        ICSTR(NCSTR:NCSTR)=IQUOTE
19334        NCSTR=NCSTR+1
19335        ICSTR(NCSTR:NCSTR+7)='text/css'
19336        NCSTR=NCSTR+8
19337        ICSTR(NCSTR:NCSTR)=IQUOTE
19338        NCSTR=NCSTR+1
19339        ICSTR(NCSTR:NCSTR+1)='?>'
19340        NCSTR=-(NCSTR+1)
19341        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19342      ENDIF
19343C
19344      NCHTOT=6
19345      IXTEMP=INT(ANUMHP)
19346      IYTEMP=INT(ANUMVP)
19347C
19348      ICSTR(1:11)='<svg xmlns='
19349      ICSTR(12:12)=IQUOTE
19350      ICSTR(13:38)='http://www.w3.org/2000/svg'
19351      ICSTR(39:39)=IQUOTE
19352      NCSTR=-39
19353      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19354      ICSTR(1:17)='     xmlns:xlink='
19355      ICSTR(18:18)=IQUOTE
19356      ICSTR(19:46)='http://www.w3.org/1999/xlink'
19357      ICSTR(47:47)=IQUOTE
19358      ICSTR(48:58)=' xml:space='
19359      ICSTR(59:59)=IQUOTE
19360      ICSTR(60:67)='preserve'
19361      ICSTR(68:68)=IQUOTE
19362      NCSTR=-68
19363      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19364C
19365      ICSTR(1:11)='     width='
19366      ICSTR(12:12)=IQUOTE
19367      NCSTR=12
19368C
19369      IF(IXTEMP.LE.9)THEN
19370        NCHTOT=1
19371      ELSEIF(IXTEMP.LE.99)THEN
19372        NCHTOT=2
19373      ELSEIF(IXTEMP.LE.999)THEN
19374        NCHTOT=3
19375      ELSEIF(IXTEMP.LE.9999)THEN
19376        NCHTOT=4
19377      ELSE
19378        NCHTOT=5
19379      ENDIF
19380C
19381      CALL GRTRIN(IXTEMP,NCHTOT,ICSTR,NCSTR)
19382      NCSTR=NCSTR+1
19383      ICSTR(NCSTR:NCSTR)=IQUOTE
19384      NCSTR=NCSTR+1
19385      ICSTR(NCSTR:NCSTR+7)=' height='
19386      NCSTR=NCSTR+8
19387      ICSTR(NCSTR:NCSTR)=IQUOTE
19388C
19389      IF(IYTEMP.LE.9)THEN
19390        NCHTOT=1
19391      ELSEIF(IYTEMP.LE.99)THEN
19392        NCHTOT=2
19393      ELSEIF(IYTEMP.LE.999)THEN
19394        NCHTOT=3
19395      ELSEIF(IYTEMP.LE.9999)THEN
19396        NCHTOT=4
19397      ELSE
19398        NCHTOT=5
19399      ENDIF
19400C
19401      CALL GRTRIN(IYTEMP,NCHTOT,ICSTR,NCSTR)
19402      NCHTOT=5
19403      NCSTR=NCSTR+1
19404      ICSTR(NCSTR:NCSTR)=IQUOTE
19405      NCSTR=-NCSTR
19406      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19407      ICSTR(1:13)='     viewBox='
19408      ICSTR(14:14)=IQUOTE
19409      ICSTR(15:18)='0 0 '
19410      NCSTR=18
19411      CALL GRTRIN(IXTEMP,NCHTOT,ICSTR,NCSTR)
19412      NCSTR=NCSTR+1
19413      ICSTR(NCSTR:NCSTR)=' '
19414      CALL GRTRIN(IYTEMP,NCHTOT,ICSTR,NCSTR)
19415      NCSTR=NCSTR+1
19416      ICSTR(NCSTR:NCSTR)=IQUOTE
19417      NCSTR=NCSTR+1
19418      ICSTR(NCSTR:NCSTR)='>'
19419      NCSTR=-NCSTR
19420      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19421C
19422      ICSTR(1:9)='   <desc>'
19423      NCSTR=-9
19424      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19425      ICSTR(1:47)='   SVG GRAPHIC CREATED BY DATAPLOT: SEPTEMBER, '
19426      ICSTR(48:60)='2010 VERSION.'
19427      NCSTR=-60
19428      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19429      ICSTR(1:10)='   </desc>'
19430      NCSTR=-10
19431      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19432C
19433      ICSTR(1:9)='   <g id='
19434      ICSTR(10:10)=IQUOTE
19435      ICSTR(11:25)='dataplot graph1'
19436      ICSTR(26:26)=IQUOTE
19437      ICSTR(27:27)='>'
19438      NCSTR=-27
19439      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19440C
19441C  CREATE BACKGROUND VIA FILLED RECTANGLE
19442C
19443      ISVGLN=ISVGLN+1
19444      ICSTR(1:9)='   <g id='
19445      ICSTR(10:10)=IQUOTE
19446      NCSTR=10
19447      NCHTOT=1
19448      CALL GRTRIN(ISVGLN,NCHTOT,ICSTR,NCSTR)
19449      NCSTR=NCSTR+1
19450      ICSTR(NCSTR:NCSTR)=IQUOTE
19451      NCSTR=NCSTR+1
19452      ICSTR(NCSTR:NCSTR)='>'
19453      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19454C
19455      ICSTR(1:11)='   <rect x='
19456      NCSTR=-11
19457      ICSTR(12:12)=IQUOTE
19458      ICSTR(13:13)='0'
19459      ICSTR(14:14)=IQUOTE
19460      ICSTR(15:17)=' y='
19461      ICSTR(18:18)=IQUOTE
19462      ICSTR(19:19)='0'
19463      ICSTR(20:20)=IQUOTE
19464      NCSTR=-20
19465      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19466C
19467      ICSTR(1:15)='         width='
19468      ICSTR(16:16)=IQUOTE
19469      ICSTR(17:20)='100%'
19470      ICSTR(21:21)=IQUOTE
19471      ICSTR(22:29)=' height='
19472      ICSTR(30:30)=IQUOTE
19473      ICSTR(31:34)='100%'
19474      ICSTR(35:35)=IQUOTE
19475      NCSTR=-35
19476      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19477C
19478      ICASE='BACK'
19479      CALL GRTRCO(ICASE,IBACCO,JCOL)
19480C
19481      ICSTR(1:15)='         style='
19482      ICSTR(16:16)=IQUOTE
19483      ICSTR(17:29)='stroke:none; '
19484      ICSTR(30:35)='fill:#'
19485      NCSTR=35
19486      NCHTOT=2
19487      JTEMP=JCOL
19488      IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JTEMP=1
19489      JRED=IRED(JTEMP)
19490      CALL DPCONX(JRED,ICJUNK)
19491      NCSTR=NCSTR+1
19492      ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
19493      NCSTR=NCSTR+1
19494      JGREEN=IGREEN(JTEMP)
19495      CALL DPCONX(JGREEN,ICJUNK)
19496      NCSTR=NCSTR+1
19497      ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
19498      NCSTR=NCSTR+1
19499      JBLUE=IBLUE(JTEMP)
19500      CALL DPCONX(JBLUE,ICJUNK)
19501      NCSTR=NCSTR+1
19502      ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
19503      NCSTR=NCSTR+2
19504      ICSTR(NCSTR:NCSTR)=';'
19505      NCSTR=NCSTR+1
19506      ICSTR(NCSTR:NCSTR)=IQUOTE
19507      ICSTR(NCSTR+1:NCSTR+2)='/>'
19508      NCSTR=NCSTR+2
19509      NCSTR=-NCSTR
19510      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19511C
19512      ICSTR(1:7)='   </g>'
19513      NCSTR=7
19514      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19515C
19516      GOTO9000
19517C
19518C               ******************************************************
19519C               **  STEP 170--                                      **
19520C               **  TREAT THE CAIRO                          DRIVER **
19521C               ******************************************************
19522C
1952317000 CONTINUE
19524#ifdef HAVE_CAIRO
19525C
19526C     SPECIFY THE SPECIFIC DEVICE AND WHETHER WE HAVE DEVICE 1, 2 OR 3.
19527C
19528      IVAL1=0
19529      IF(IMODEL.EQ.'X11')IVAL1=1
19530      IF(IMODEL.EQ.'POST')IVAL1=2
19531      IF(IMODEL.EQ.'PDF')IVAL1=3
19532      IF(IMODEL.EQ.'SVG')IVAL1=4
19533      IF(IMODEL.EQ.'QUAR')IVAL1=5
19534      IF(IMODEL.EQ.'PNG')IVAL1=6
19535      IF(IMODEL.EQ.'WIND')IVAL1=7
19536      IF(IMODEL.EQ.'EPS')IVAL1=8
19537      IF(IVAL1.EQ.0)THEN
19538        WRITE(ICOUT,999)
19539        CALL DPWRST('XXX','BUG ')
19540        WRITE(ICOUT,17006)IMODEL
1954117006   FORMAT('***** ERROR: MODEL ',A4, ' IS NOT SUPPORTED FOR CAIRO.')
19542        CALL DPWRST('XXX','BUG ')
19543      ENDIF
19544      IVAL2=1
19545      IF(IGUNIT.EQ.IPL1NU)THEN
19546C
19547C       DEVICE 2 OUTPUT
19548C
19549        ICAIPN=1
19550        IVAL2=2
19551        DO17011I=80,1,-1
19552          ILAST=I
19553          IF(IPL1NA(I:I).NE.' ')GOTO17014
1955417011   CONTINUE
19555        ILAST=1
1955617014   CONTINUE
19557        DO17019I=1,ILAST
19558          CALL DPCOAN(IPL1NA(I:I),IJUNK)
19559          IADE(I)=IJUNK
1956017019   CONTINUE
19561        IADE(ILAST+1)=0
19562      ELSEIF(IGUNIT.EQ.IPL2NU)THEN
19563C
19564C       DEVICE 3 OUTPUT
19565C
19566        ICAIP2=1
19567        IVAL2=3
19568        DO17021I=80,1,-1
19569          ILAST=I
19570          IF(IPL2NA(I:I).NE.' ')GOTO17024
1957117021   CONTINUE
19572        ILAST=1
1957317024   CONTINUE
19574        DO17029I=1,ILAST
19575          CALL DPCOAN(IPL2NA(I:I),IJUNK)
19576          IADE(I)=IJUNK
1957717029   CONTINUE
19578        IADE(ILAST+1)=0
19579      ELSE
19580C
19581C       DEVICE 1 OUTPUT - SCREEN DEVICES ONLY (NO FILENAME)
19582C
19583        IADE(1)=0
19584      ENDIF
19585C
19586      ICASE='BACK'
19587      CALL GRTRCO(ICASE,IBACCO,JCOL)
19588      ATEMP=255.0
19589      ARED=REAL(IRED(JCOL))/ATEMP
19590      AGREEN=REAL(IGREEN(JCOL))/ATEMP
19591      ABLUE=REAL(IBLUE(JCOL))/ATEMP
19592C
19593      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'INDE')THEN
19594        WRITE(ICOUT,17051)IVAL2,IVAL1,IXTEMP,IYTEMP
1959517051   FORMAT('GRINDE: BEFORE CAINIT, IVAL2,IVAL1,IXTEMP,IYTEMP: ',4I8)
19596        CALL DPWRST('XXX','BUG ')
19597      ENDIF
19598C
19599C     NOTES:
19600C
19601C     1. X11 IS ONLY SUPPORTED FOR DEVICE 1
19602C     2. POSTSCRIPT/PDF, SVG, PNG ONLY SUPPORTED FOR DEVICES 2 AND 3
19603C
19604      IF(IVAL1.EQ.1 .AND. IVAL2.GT.1)THEN
19605        WRITE(ICOUT,999)
19606        CALL DPWRST('XXX','BUG ')
19607        WRITE(ICOUT,17062)
1960817062   FORMAT('****** ERROR IN OPENING CAIRO X11 DEVICE')
19609        CALL DPWRST('XXX','BUG ')
19610        WRITE(ICOUT,17064)
1961117064   FORMAT('       X11 IS ONLY SUPPORTED FOR DEVICE 1')
19612        CALL DPWRST('XXX','BUG ')
19613        IERROR='YES'
19614        GOTO9000
19615      ELSEIF(IVAL1.EQ.2 .AND. IVAL2.EQ.1)THEN
19616        WRITE(ICOUT,999)
19617        CALL DPWRST('XXX','BUG ')
19618        WRITE(ICOUT,17072)
1961917072   FORMAT('****** ERROR IN OPENING CAIRO POSTSCRIPT DEVICE')
19620        CALL DPWRST('XXX','BUG ')
19621        WRITE(ICOUT,17074)
1962217074   FORMAT('       POSTSCRIPT IS NOT SUPPORTED FOR DEVICE 1')
19623        CALL DPWRST('XXX','BUG ')
19624        IERROR='YES'
19625        GOTO9000
19626      ELSEIF(IVAL1.EQ.3 .AND. IVAL2.EQ.1)THEN
19627        WRITE(ICOUT,999)
19628        CALL DPWRST('XXX','BUG ')
19629        WRITE(ICOUT,17082)
1963017082   FORMAT('****** ERROR IN OPENING CAIRO PDF DEVICE')
19631        CALL DPWRST('XXX','BUG ')
19632        WRITE(ICOUT,17084)
1963317084   FORMAT('       PDF IS NOT SUPPORTED FOR DEVICE 1')
19634        CALL DPWRST('XXX','BUG ')
19635        IERROR='YES'
19636        GOTO9000
19637      ELSEIF(IVAL1.EQ.4 .AND. IVAL2.EQ.1)THEN
19638        WRITE(ICOUT,999)
19639        CALL DPWRST('XXX','BUG ')
19640        WRITE(ICOUT,17092)
1964117092   FORMAT('****** ERROR IN OPENING CAIRO SVG DEVICE')
19642        CALL DPWRST('XXX','BUG ')
19643        WRITE(ICOUT,17094)
1964417094   FORMAT('       SVG IS NOT SUPPORTED FOR DEVICE 1')
19645        CALL DPWRST('XXX','BUG ')
19646        IERROR='YES'
19647        GOTO9000
19648      ELSEIF(IVAL1.EQ.6 .AND. IVAL2.EQ.1)THEN
19649        WRITE(ICOUT,999)
19650        CALL DPWRST('XXX','BUG ')
19651        WRITE(ICOUT,17097)
1965217097   FORMAT('****** ERROR IN OPENING CAIRO PNG DEVICE')
19653        CALL DPWRST('XXX','BUG ')
19654        WRITE(ICOUT,17098)
1965517098   FORMAT('       PNG IS NOT SUPPORTED FOR DEVICE 1')
19656        CALL DPWRST('XXX','BUG ')
19657        IERROR='YES'
19658        GOTO9000
19659      ENDIF
19660      CALL CAINIT(IVAL2,IVAL1,IADE,ANUMHP,ANUMVP,
19661     1            ARED,AGREEN,ABLUE,IERR)
19662      IF(IERR.GT.0)THEN
19663C
19664C       PRINT ERROR MESSAGE
19665C
19666C       TURN DEVICE POWER OFF
19667C
19668C
19669      ENDIF
19670C
19671#endif
19672      GOTO9000
19673C
19674C               ******************************************************
19675C               **  STEP 180--                                      **
19676C               **  TREAT THE WMF                            DRIVER **
19677C               ******************************************************
19678C
1967918000 CONTINUE
19680      GOTO9000
19681C
19682C               ******************************************************
19683C               **  STEP 190--                                      **
19684C               **  TREAT THE D3                             DRIVER **
19685C               ******************************************************
19686C
1968719000 CONTINUE
19688      GOTO9000
19689C
19690C               *****************
19691C               **  STEP 90--  **
19692C               **  EXIT       **
19693C               *****************
19694C
19695 9000 CONTINUE
19696      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'INDE')THEN
19697        WRITE(ICOUT,999)
19698        CALL DPWRST('XXX','BUG ')
19699        WRITE(ICOUT,9011)
19700 9011   FORMAT('***** AT THE END       OF GRINDE--')
19701        CALL DPWRST('XXX','BUG ')
19702        WRITE(ICOUT,9023)NCSTR,IERRG4
19703 9023   FORMAT('NCSTR,IERRG4 = ',I8,2X,A4)
19704        CALL DPWRST('XXX','BUG ')
19705        IF(NCSTR.GT.0)THEN
19706          DO9025I=1,NCSTR
19707            CALL DPCOAN(ICSTR(I:I),IASCNE)
19708            WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
19709 9026       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
19710            CALL DPWRST('XXX','BUG ')
19711 9025     CONTINUE
19712        ENDIF
19713      ENDIF
19714C
19715      RETURN
19716      END
19717      SUBROUTINE GRMOBE(PX,PY)
19718C
19719C     PURPOSE--MOVE THE BEAM TO THE POINT (PX,PY)
19720C              ON A SPECIFIC GRAPHICS DEVICE.
19721C     NOTE--THE COORDINATES IN (PX,PY) ARE IN
19722C           STANDARDIZED (0.0 TO 100.0) UNITS.
19723C
19724C     WRITTEN BY--JAMES J. FILLIBEN
19725C                 STATISTICAL ENGINEERING DIVISION
19726C                 INFORMATION TECHNOLOGY LABORATORY
19727C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
19728C                 GAITHERSBURG, MD 20899-8980
19729C                 PHONE--301-975-2855
19730C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
19731C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
19732C     LANGUAGE--ANSI FORTRAN (1977)
19733C     VERSION NUMBER--83.6
19734C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
19735C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
19736C                                      DRIVER OBSOLETE
19737C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
19738C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
19739C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
19740C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
19741C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
19742C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
19743C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
19744C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
19745C                                      DRIVER OBSOLETE
19746C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
19747C                                      OLD CALCOMP STYLE DRIVER
19748C                                      DRIVER OBSOLETE
19749C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
19750C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
19751C                                      USE BILL MITCHELLS OPENGL
19752C                                      BINDING FOR FORTRAN
19753C     UPDATED         --OCTOBER  1996. GKS (ALAN)
19754C                                      CODED, NOT TESTED
19755C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
19756C                                      PLACEHOLDER FOR NOW
19757C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
19758C                                      PLACEHOLDER FOR NOW
19759C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
19760C     UPDATED         --DECEMBER 1997. UPDATE TO GENERAL CODED FOR GUI
19761C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
19762C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
19763C     UPDATED         --JUNE     2000. MACINTOSH
19764C                                      PLACEHOLDER FOR NOW
19765C     UPDATED         --JUNE     2000. PC PRINTER
19766C                                      PLACEHOLDER FOR NOW
19767C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
19768C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
19769C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
19770C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
19771C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
19772C
19773C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
19774C
19775#ifdef HAVE_WININTERACTER
19776      USE WINTERACTER
19777#endif
19778#ifdef HAVE_INTERACTER
19779      USE INTERACTER
19780#endif
19781#ifdef HAVE_QWIN
19782CQWIN USE DFLIB
19783      USE IFQWIN
19784CCCCC LOGICAL MODESTATUS
19785      TYPE (WINDOWCONFIG)   DPSCREEN
19786      TYPE (XYCOORD)   WXY
19787      CHARACTER*4 QWSCRN
19788      COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
19789#endif
19790C
19791      INTEGER IGKSID
19792      INTEGER IGKSWK
19793      INTEGER IGKSTY
19794      COMMON/IGKS/IGKSID,IGKSWK,IGKSTY
19795C
19796      CHARACTER*130 ICSTR
19797      CHARACTER*4 ISUBN0
19798      CHARACTER*1 ICARAT
19799C
19800C-----COMMON----------------------------------------------------------
19801C
19802      INCLUDE 'DPCOPA.INC'
19803      INCLUDE 'DPCOGR.INC'
19804      INCLUDE 'DPCONP.INC'
19805      INCLUDE 'DPCOBE.INC'
19806      INCLUDE 'DPCODV.INC'
19807      INCLUDE 'DPCOF2.INC'
19808      INCLUDE 'DPCOP2.INC'
19809C
19810C-----START POINT-----------------------------------------------------
19811C
19812      ISUBN0='MOBE'
19813      IERRG4='NO'
19814C
19815      NCSTR=(-999)
19816C
19817      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'MOBE')THEN
19818        WRITE(ICOUT,999)
19819  999   FORMAT(1X)
19820        CALL DPWRST('XXX','BUG ')
19821        WRITE(ICOUT,51)
19822   51   FORMAT('***** AT THE BEGINNING OF GRMOBE--')
19823        CALL DPWRST('XXX','BUG ')
19824        WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3
19825   52   FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',3(A4,2X),A4)
19826        CALL DPWRST('XXX','BUG ')
19827        WRITE(ICOUT,54)IGCODE,ISOFT,ISOFT2,ISOFT3
19828   54   FORMAT('IGCODE,ISOFT,ISOFT2,ISOFT3 = ',3(A4,2X),A4)
19829        CALL DPWRST('XXX','BUG ')
19830        WRITE(ICOUT,55)IGBAUD,IGUNIT,PX,PY
19831   55   FORMAT('IGBAUD,IGUNIT,PX,PY = ',2I8,2G15.7)
19832        CALL DPWRST('XXX','BUG ')
19833        WRITE(ICOUT,59)IBUGG4,ISUBG4,IERRG4
19834   59   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
19835        CALL DPWRST('XXX','BUG ')
19836      ENDIF
19837C
19838C               ********************************************
19839C               **  STEP 1--                              **
19840C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
19841C               **  AND THE MODEL                         **
19842C               ********************************************
19843C
19844      IF(IMANUF.EQ.'QWIN')THEN
19845        GOTO4700
19846      ELSEIF(IMANUF.EQ.'POST')THEN
19847        GOTO8600
19848      ELSEIF(IMANUF.EQ.'X11 ')THEN
19849        GOTO9600
19850      ELSEIF(IMANUF.EQ.'AQUA')THEN
19851        GOTO13500
19852      ELSEIF(IMANUF.EQ.'GENE')THEN
19853        IF(IMODEL.EQ.'CODE')GOTO3200
19854        IF(IMODEL.EQ.'CGM')GOTO3300
19855        IF(IMODEL.EQ.'CGMB')GOTO3400
19856        GOTO3100
19857      ELSEIF(IMANUF.EQ.'SVG ')THEN
19858        GOTO16000
19859      ELSEIF(IMANUF.EQ.'GD  ')THEN
19860        GOTO12000
19861      ELSEIF(IMANUF.EQ.'LATE')THEN
19862        GOTO15000
19863      ELSEIF(IMANUF.EQ.'CAIR')THEN
19864        GOTO17000
19865      ELSEIF(IMANUF.EQ.'D3  ')THEN
19866        GOTO19000
19867      ELSEIF(IMANUF.EQ.'WMF ')THEN
19868        GOTO18000
19869      ELSEIF(IMANUF.EQ.'OPGL')THEN
19870        GOTO4800
19871      ELSEIF(IMANUF.EQ.'TEKT')THEN
19872        GOTO1100
19873      ELSEIF(IMANUF.EQ.'HP')THEN
19874        IF(IMODEL.EQ.'7221')GOTO2100
19875        IF(IMODEL.EQ.'2622')GOTO2300
19876        IF(IMODEL.EQ.'2623')GOTO2300
19877        IF(IMODEL.EQ.'2627')GOTO2300
19878        IF(IMODEL.EQ.'2647')GOTO2300
19879        GOTO2200
19880      ELSEIF(IMANUF.EQ.'LIBP')THEN
19881        GOTO2600
19882      ELSEIF(IMANUF.EQ.'REGI')THEN
19883        GOTO8100
19884      ELSEIF(IMANUF.EQ.'GKS ')THEN
19885        GOTO11000
19886      ELSEIF(IMANUF.EQ.'LAHE')THEN
19887        IF(IMODEL.EQ.'INTE')GOTO4900
19888        IF(IMODEL.EQ.'WINT')GOTO4950
19889        GOTO4600
19890      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
19891        GOTO13000
19892      ELSEIF(IMANUF.EQ.'QUIC')THEN
19893        GOTO9100
19894      ELSEIF(IMANUF.EQ.'CALC')THEN
19895        GOTO4100
19896      ELSEIF(IMANUF.EQ.'ZETA')THEN
19897        GOTO5100
19898      ELSEIF(IMANUF.EQ.'TURB')THEN
19899        GOTO10000
19900      ELSEIF(IMANUF.EQ.'SUN ')THEN
19901        GOTO6600
19902      ENDIF
19903      GOTO9000
19904C
19905C               ******************************************************
19906C               **   STEP 11--                                      **
19907C               **   TREAT THE TEKTRONIX CASE                       **
19908C               ******************************************************
19909C
19910 1100 CONTINUE
19911      IFACTO=4
19912      IF(NUMVPP.GE.3000)IFACTO=1
19913      ICSTR(1:1)=IGSC
19914      NCSTR=1
19915      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
19916      CALL TKTRPT(IX,IY,IFACTO,ICSTR,NCSTR,ISUBN0)
19917      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19918      GOTO9000
19919C
19920C               ******************************************************
19921C               **  STEP 21--                                       **
19922C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
19923C               **  (MULTI-COLOR PENPLOTTER)                        **
19924C               **  TO MOVE BEAM (= MOVE PEN)--                     **
19925C               **  USE THE LOWER CASE P (= MOVE) INSTRUCTIONS      **
19926C               **  AND PACKED BINARY COORDINATES                   **
19927C               **  (WITH TRAILING RIGHT CURLY BRACKET WHICH ARE THE**
19928C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
19929C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
19930C               **             OPERATING AND PROGRAMMING MANUAL,    **
19931C               **             PAGE 81, 253.                        **
19932C               ******************************************************
19933C
19934 2100 CONTINUE
19935      ICSTR(1:1)='p'
19936      NCSTR=1
19937      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
19938      CALL HPTRPT(IX,IY,ICSTR,NCSTR,ISUBN0)
19939      NCSTR=NCSTR+1
19940      ICSTR(NCSTR:NCSTR)='}'
19941      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19942      GOTO9000
19943C
19944C               ******************************************************
19945C               **  STEP 22--                                       **
19946C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
19947C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
19948C               **  (MULTI-COLOR PENPLOTTERS)                       **
19949C               **  TO MOVE BEAM (= MOVE PEN)--                     **
19950C               **  USE THE PU (= PEN UP)                           **
19951C               **  AND PA (= PLOT ABSOLUTE) INSTRUCTION            **
19952C               **  ALONG WITH INTEGER COORDINATES                  **
19953C               **  (WITH   TRAILING SEMI-COLONS WHICH ARE THE      **
19954C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
19955C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
19956C               **             OPERATING AND PROGRAMMING MANUAL,    **
19957C               **             PAGE 62, 143.                        **
19958C               **             PAGE 65-67, 143.                     **
19959C               ******************************************************
19960C
19961 2200 CONTINUE
19962      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
19963      ICSTR(1:5)='PU;PA'
19964      NCSTR=5
19965      NCHTOT=5
19966      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
19967      ICSTR(11:11)=','
19968      NCSTR=11
19969      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
19970      ICSTR(17:17)=';'
19971      NCSTR=17
19972      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19973      GOTO9000
19974C
19975C               **********************************************************
19976C               **  STEP 23--                                           **
19977C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
19978C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
19979C               **  (MONOCHROME DISPLAY TERMINALS)                      **
19980C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
19981C               **             REFERENCE MANUAL,                        **
19982C               **             PAGE 10-12, 10-13.                       **
19983C               **********************************************************
19984C
19985 2300 CONTINUE
19986      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
19987      ICSTR(1:1)=IESCC
19988      ICSTR(2:4)='*pa'
19989      NCSTR=4
19990      NCHTOT=5
19991      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
19992      ICSTR(10:10)=','
19993      NCSTR=10
19994      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
19995      ICSTR(16:16)='Z'
19996      NCSTR=16
19997      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
19998      GOTO9000
19999C
20000C               **********************************************************
20001C               **  STEP 26--                                           **
20002C               **  TREAT THE UNIX LIBPLOT              CASE            **
20003C               **********************************************************
20004C
20005 2600 CONTINUE
20006      GOTO9000
20007C
20008C               ******************************************************
20009C               **  STEP 31--                                       **
20010C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
20011C               ******************************************************
20012C
20013 3100 CONTINUE
20014      ICSTR(1:8)='MOVE TO '
20015      NCSTR=8
20016      NCHTOT=10
20017      NCHDEC=5
20018      CALL GRTRSA(PX,PY,AX,AY,ISUBN0)
20019      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
20020      ICSTR(19:20)='  '
20021      NCSTR=20
20022      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
20023      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20024      GOTO9000
20025C
20026C               ***************************************************************
20027C               **  STEP 32--                                                **
20028C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
20029C               ***************************************************************
20030C
20031C     DECEMBER 1997.  FOR GUI, CONVERT COORDINATES TO INTEGER (BY
20032C                     MULTIPLYING BY 100).  DO NOT PRINT OUT SUCCESSIV POINTS
20033C                     IF THEY ARE IDENTICAL.
20034C
20035 3200 CONTINUE
20036      IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')THEN
20037        ICSTR(1:2)='M '
20038        NCSTR=2
20039        NCHTOT=IGENFA+3
20040        CALL GRTRSA(PX,PY,AX,AY,ISUBN0)
20041        IPX=INT(AX*10.**IGENFA+0.5)
20042        IPY=INT(AY*10.**IGENFA+0.5)
20043        CALL GRTRIN(IPX,NCHTOT,ICSTR,NCSTR)
20044        NCSTR=NCSTR+1
20045        ICSTR(NCSTR:NCSTR)=' '
20046        CALL GRTRIN(IPY,NCHTOT,ICSTR,NCSTR)
20047        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20048      ELSE
20049        ICSTR(1:5)='MOTO '
20050        NCSTR=5
20051        NCHTOT=10
20052        NCHDEC=5
20053        CALL GRTRSA(PX,PY,AX,AY,ISUBN0)
20054        CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
20055        ICSTR(16:17)='  '
20056        NCSTR=17
20057        CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
20058        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20059      ENDIF
20060C
20061      GOTO9000
20062C
20063C               ***************************************************************
20064C               **  STEP 32--                                                **
20065C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
20066C               **  CGM DOES NOT SUPPORT THIS FEATURE                        **
20067C               ***************************************************************
20068C
20069 3300 CONTINUE
20070      ICSTR(1:6)='LINE '
20071      NCSTR=6
20072      NCHTOT=10
20073      NCHDEC=5
20074      CALL GRTRSA(PX,PY,AX,AY,ISUBN0)
20075      CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR)
20076      ICSTR(17:17)=','
20077      NCSTR=17
20078      CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR)
20079      ICSTR(28:28)=';'
20080      NCSTR=28
20081C     NOTE: CGM HAS NO "MOVE" COMMAND.  USING LINE WITH ONLY THE
20082C           COORDINATES FOR THE FIRST POINT DOES NOT OFFICIALLY CONFORM
20083C           TO THE STANDARD (ALTHOUGH MOST TRANSLATORS WILL PROBABLY
20084C           HANDLE IT).  HOWEVER, THIS ROUTINE USUALLY ONLY CALLED TO
20085C           POSTION THE CURSOR, E.G. AT THE END OF A PLOT, SO NO HARM
20086C           TO SIMPLY IGNORE THIS INSTRUCTION.
20087CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20088      GOTO9000
20089C
20090C               ***************************************************
20091C               **  STEP 34--                                    **
20092C               **  TREAT THE CGM (BINARY)                 CASE  **
20093C               ***************************************************
20094C
20095 3400 CONTINUE
20096      GOTO9000
20097C
20098C               ******************************************************
20099C               **  STEP 41--                                       **
20100C               **  TREAT THE CALCOMP XXXXXX CASE                   **
20101C               **  TO MOVE BEAM (= MOVE PEN)--                     **
20102C               **  WRITE OUT AN XXXXXXXXXX                         **
20103C               **  REFERENCE--USE CALCOMP LIBRARY ROUTINE          **
20104C               **             XX                                   **
20105C               **             PAGES XX AND XX                      **
20106C               ******************************************************
20107C
20108 4100 CONTINUE
20109#ifdef HAVE_CALCOMP
20110      CALL CALCPT(PX,PY,PXA,PYA,ISUBN0)
20111      IPEN=3
20112      CALL PLOT(PXA,PYA,IPEN)
20113#endif
20114      GOTO9000
20115C
20116C               ******************************************************
20117C               **  STEP 46--                                       **
20118C               **  TREAT THE LAHEY   XXXXXX CASE                   **
20119C               **  REFERENCE--Programmer's Reference, Revision C   **
20120C               **             Lahey Computer Systems, January, 1992**
20121C               **             PAGES 51 THRU 65                     **
20122C               ******************************************************
20123C
20124 4600 CONTINUE
20125#ifdef HAVE_LAHEY_CALCOMP
20126      CALL CALCPT(PX,PY,PXA,PYA,ISUBN0)
20127      IPEN=3
20128      CALL PLOT(PXA,PYA,IPEN)
20129#endif
20130      GOTO9000
20131C
20132C               ******************************************************
20133C               **  STEP 47--                                       **
20134C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
20135C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
20136C               ******************************************************
20137C
20138 4700 CONTINUE
20139      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
20140#ifdef HAVE_QWIN
20141      CALL MOVETO(INT2(IX),INT2(IY),WXY)
20142#endif
20143      GOTO9000
20144C
20145C               ******************************************************
20146C               **  STEP 48--                                       **
20147C               **  TREAT THE OPEN-GL DRIVER                        **
20148C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
20149C               ******************************************************
20150C
20151 4800 CONTINUE
20152      GOTO9000
20153C
20154C               ******************************************************
20155C               **  STEP 49--                                       **
20156C               **  TREAT THE LAHEY INTERACTOR CASE                 **
20157C               ******************************************************
20158C
20159 4900 CONTINUE
20160      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
20161#ifdef HAVE_INTERACTER
20162      CALL IGrMoveTo(REAL(IX),REAL(IY))
20163#endif
20164      GOTO9000
20165C
20166C               ******************************************************
20167C               **  STEP 49B-                                       **
20168C               **  TREAT THE LAHEY WINTERACTOR CASE                **
20169C               ******************************************************
20170C
20171 4950 CONTINUE
20172      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
20173#ifdef HAVE_WININTERACTER
20174      CALL IGrMoveTo(REAL(IX),REAL(IY))
20175#endif
20176      GOTO9000
20177C
20178C
20179C               ******************************************************
20180C               **  STEP 51--                                       **
20181C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
20182C               **  TO MOVE BEAM (= MOVE PEN)--                     **
20183C               **  USE THE 1 OP CODE (= PEN UP) AND                **
20184C               **  THE VECTOR PLOT (A TO X + COOR) OP CODES        **
20185C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
20186C               **             MODELS 3600SX AND 3653SX             **
20187C               **             PAGES B-0 AND B-1                    **
20188C               **  USE THE CALCOMP LIBRARY ROUTINES
20189C               ******************************************************
20190C
20191 5100 CONTINUE
20192#ifdef HAVE_ZETA
20193      CALL CALCPT(PX,PY,PXA,PYA,ISUBN0)
20194      IPEN=3
20195      CALL PLOT(PXA,PYA,IPEN)
20196#endif
20197      GOTO9000
20198C
20199C               ******************************************************
20200C               **  STEP 66--                                       **
20201C               **  TREAT THE SUN CASE                              **
20202C               ******************************************************
20203C
20204 6600 CONTINUE
20205      GOTO 9000
20206C
20207C               ******************************************************
20208C               **  STEP 81--                                       **
20209C               **  TREAT THE DEC  REGIS CASE                       **
20210C               **  TO MOVE BEAM (= MOVE PEN)--                     **
20211C               **  USE THE P[ (= POSITION) COMMAND                 **
20212C               **  ALONG WITH INTEGER COORDINATES                  **
20213C               **  WITH A   TRAILING ]                             **
20214C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
20215C               **             PAGE 101                             **
20216C               ******************************************************
20217C
20218 8100 CONTINUE
20219      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
20220      ICSTR(1:2)='P['
20221      NCSTR=2
20222      NCHTOT=5
20223      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
20224      ICSTR(8:8)=','
20225      NCSTR=8
20226      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
20227      ICSTR(14:14)=']'
20228      NCSTR=14
20229      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20230      GOTO9000
20231C
20232C               ******************************************************
20233C               **  STEP 86--                                       **
20234C               **  TREAT THE POSTSCRIPT CASE                       **
20235C               **  1)  XCOOR  YCOOR  MOVETO                        **
20236C               **  2)  STROKE                                      **
20237C               **  REFERENCE: POSTSCRIPT LANGUAGE TUTORIAL AND     **
20238C               **  COOKBOOK FROM ADOBE SYSTEMS                     **
20239C               ******************************************************
20240C
20241 8600 CONTINUE
20242      ICSTR(1:8)='newpath '
20243      NCSTR=8
20244      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
20245      NCHTOT=5
20246      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
20247      ICSTR(14:14)=' '
20248      NCSTR=14
20249      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
20250      ICSTR(20:33)=' moveto stroke'
20251      NCSTR=33
20252      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20253      GOTO9000
20254C
20255C               ******************************************************
20256C               **  STEP 91--                                       **
20257C               **  TREAT THE QUIC       CASE                       **
20258C               **  1) ^IVvvvvv- VERTICAL POSITION RELATIVE TO TOP  **
20259C               **               OF PAGE (QUICPT WILL ADD MARGIN)   **
20260C               **  2) ^IHhhhhh- HORIZONTAL POSITION RELATIVE TO    **
20261C               **               LEFT OF PAGE                       **
20262C               **  REFERENCE: QUIC PROGRAMMING MANUAL              **
20263C               **  PAGES: 6-9, 6-12                                **
20264C               ******************************************************
20265C
20266 9100 CONTINUE
20267      CALL DPCONA(94,ICARAT)
20268      PYTEMP=100.-PY
20269      CALL QUICPT(PX,PYTEMP,IX1,IY1,ISUBN0)
20270      ICSTR(1:1)=ICARAT
20271      ICSTR(2:3)='IV'
20272      NCSTR=3
20273      NCHTOT=-5
20274      CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR)
20275      ICSTR(9:9)=ICARAT
20276      ICSTR(10:11)='IH'
20277      NCHTOT=-5
20278      NCSTR=11
20279      CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR)
20280      NCSTR=16
20281      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20282      GOTO9000
20283C
20284C               ******************************************************
20285C               **  STEP 96--                                       **
20286C               **  TREAT THE X11        CASE - NULL ROUTINE        **
20287C               ******************************************************
20288C
20289 9600 CONTINUE
20290      GOTO9000
20291C
20292C               *************************************************
20293C               **  STEP 100--                                 **
20294C               **  TREAT THE VGA VIA TURBO-C       CASE       **
20295C               *************************************************
20296C
2029710000 CONTINUE
20298CTURB CALL TCMOTO(PX,PY)
20299      GOTO9000
20300C
20301C               ******************************************************
20302C               **  STEP 110--                                      **
20303C               **  TREAT THE GKS                DRIVER             **
20304C               ******************************************************
20305C
2030611000 CONTINUE
20307      GOTO9000
20308C
20309C               ******************************************************
20310C               **  STEP 120--                                      **
20311C               **  TREAT THE GD                     DRIVER         **
20312C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
20313C               **  1) JPEG                                         **
20314C               **  2) PNG                                          **
20315C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
20316C               **  NULL ROUTINE                                    **
20317C               ******************************************************
20318C
2031912000 CONTINUE
20320      GOTO9000
20321C
20322C               ******************************************************
20323C               **  STEP 130--                                      **
20324C               **  TREAT THE ABSOFT                 DRIVER         **
20325C               ******************************************************
20326C
2032713000 CONTINUE
20328      GOTO9000
20329C
20330C               ******************************************************
20331C               **  STEP 135--                                      **
20332C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
20333C               ******************************************************
20334C
2033513500 CONTINUE
20336      CALL GRTRSD(PX,PY,IX,IY,ISUBN0)
20337      AX1=REAL(IX)
20338      AY1=REAL(IY)
20339#ifdef HAVE_AQUA
20340      CALL aqmove(AX1,AY1)
20341#endif
20342      GOTO9000
20343C
20344C               ******************************************************
20345C               **  STEP 150--                                      **
20346C               **  TREAT THE LATEX (EEPIC)                  DRIVER **
20347C               ******************************************************
20348C
2034915000 CONTINUE
20350      GOTO9000
20351C
20352C               ******************************************************
20353C               **  STEP 160--                                      **
20354C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
20355C               ******************************************************
20356C
2035716000 CONTINUE
20358      GOTO9000
20359C
20360C               ******************************************************
20361C               **  STEP 170--                                      **
20362C               **  TREAT THE CAIRO                          DRIVER **
20363C               ******************************************************
20364C
2036517000 CONTINUE
20366#ifdef HAVE_CAIRO
20367C
20368      IVAL2=1
20369      IF(IGUNIT.EQ.IPL1NU)IVAL2=2
20370      IF(IGUNIT.EQ.IPL2NU)IVAL2=3
20371C
20372      AX1=PX
20373      AY1=PY
20374      CALL GRTRSD(AX1,AY1,IX,IY,ISUBN0)
20375      CALL CAMOVE(IVAL2,AX1,AY1)
20376#endif
20377      GOTO9000
20378C
20379C               ******************************************************
20380C               **  STEP 180--                                      **
20381C               **  TREAT THE WMF                            DRIVER **
20382C               ******************************************************
20383C
2038418000 CONTINUE
20385      GOTO9000
20386C
20387C               ******************************************************
20388C               **  STEP 190--                                      **
20389C               **  TREAT THE D3                             DRIVER **
20390C               ******************************************************
20391C
2039219000 CONTINUE
20393      GOTO9000
20394C
20395C               *****************
20396C               **  STEP 90--  **
20397C               **  EXIT       **
20398C               *****************
20399C
20400 9000 CONTINUE
20401      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'MOBE')THEN
20402        WRITE(ICOUT,999)
20403        CALL DPWRST('XXX','BUG ')
20404        WRITE(ICOUT,9011)
20405 9011   FORMAT('***** AT THE END       OF GRMOBE--')
20406        CALL DPWRST('XXX','BUG ')
20407        WRITE(ICOUT,9023)NCSTR,IERRG4
20408 9023   FORMAT('NCSTR,IERRG4 = ',I8,2X,A4)
20409        CALL DPWRST('XXX','BUG ')
20410        IF(NCSTR.GT.0)THEN
20411          DO9025I=1,NCSTR
20412            CALL DPCOAN(ICSTR(I:I),IASCNE)
20413            WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
20414 9026       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
20415            CALL DPWRST('XXX','BUG ')
20416 9025     CONTINUE
20417        ENDIF
20418      ENDIF
20419C
20420      RETURN
20421      END
20422      SUBROUTINE GROPDE
20423C
20424C     PURPOSE--OPEN A SPECIFIC GRAPHICS DEVICE.  THAT IS, TURN ON
20425C              (= EMPOWER) A DEVICE WHICH IS CURRENTLY OFF.
20426C
20427C     WRITTEN BY--JAMES J. FILLIBEN
20428C                 STATISTICAL ENGINEERING DIVISION
20429C                 INFORMATION TECHNOLOGY LABORATORY
20430C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
20431C                 GAITHERSBURG, MD 20899-8980
20432C                 PHONE--301-975-2855
20433C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
20434C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
20435C     LANGUAGE--ANSI FORTRAN (1977)
20436C     VERSION NUMBER--83.6
20437C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
20438C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
20439C                                      DRIVER OBSOLETE
20440C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
20441C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
20442C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
20443C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
20444C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
20445C     UPDATED         --APRIL    1989. SOFT-CODE BACKSLASH FOR UNIX
20446C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
20447C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
20448C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
20449C                                      DRIVER OBSOLETE
20450C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
20451C                                      OLD CALCOMP STYLE DRIVER
20452C                                      DRIVER OBSOLETE
20453C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
20454C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
20455C                                      USE BILL MITCHELLS OPENGL
20456C                                      BINDING FOR FORTRAN
20457C     UPDATED         --OCTOBER  1996. GKS (ALAN)
20458C                                      CODED, NOT TESTED
20459C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
20460C                                      PLACEHOLDER FOR NOW
20461C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
20462C                                      PLACEHOLDER FOR NOW
20463C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
20464C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
20465C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
20466C     UPDATED         --JUNE     2000. MACINTOSH
20467C                                      PLACEHOLDER FOR NOW
20468C     UPDATED         --JUNE     2000. PC PRINTER
20469C                                      PLACEHOLDER FOR NOW
20470C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
20471C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
20472C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
20473C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
20474C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
20475C
20476C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
20477C
20478#ifdef HAVE_WININTERACTER
20479      USE WINTERACTER
20480#endif
20481#ifdef HAVE_INTERACTER
20482      USE INTERACTER
20483#endif
20484#ifdef HAVE_QWIN
20485CQWIN USE DFLIB
20486      USE IFQWIN
20487      LOGICAL MODESTATUS
20488      TYPE (WINDOWCONFIG)   DPSCREEN
20489      TYPE (QWINFO)   WINFO
20490      TYPE (FONTINFO) MSFONT
20491      TYPE (XYCOORD) XY
20492      CHARACTER*4 QWSCRN
20493      COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
20494#endif
20495C
20496      CHARACTER*130 ICSTR
20497      CHARACTER*4 ISUBN0
20498      CHARACTER*1 ICARAT
20499C
20500C-----COMMON----------------------------------------------------------
20501C
20502      INCLUDE 'DPCOGR.INC'
20503      INCLUDE 'DPCONP.INC'
20504      INCLUDE 'DPCOBE.INC'
20505      INCLUDE 'DPCODV.INC'
20506      INCLUDE 'DPCOST.INC'
20507      INCLUDE 'DPCOP2.INC'
20508C
20509C-----START POINT-----------------------------------------------------
20510C
20511      ISUBN0='OPDE'
20512      IERRG4='NO'
20513C
20514      NCSTR=(-999)
20515C
20516      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OPDE')THEN
20517        WRITE(ICOUT,999)
20518  999   FORMAT(1X)
20519        CALL DPWRST('XXX','BUG ')
20520        WRITE(ICOUT,51)
20521   51   FORMAT('***** AT THE BEGINNING OF GROPDE--')
20522        CALL DPWRST('XXX','BUG ')
20523        WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3
20524   52   FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',3(A4,2X),A4)
20525        CALL DPWRST('XXX','BUG ')
20526        WRITE(ICOUT,54)IGCODE,ISOFT,ISOFT2,ISOFT3
20527   54   FORMAT('IGCODE,ISOFT,ISOFT2,ISOFT3 = ',3(A4,2X),A4)
20528        CALL DPWRST('XXX','BUG ')
20529        WRITE(ICOUT,55)IGBAUD,IGUNIT,NCPREP
20530   55   FORMAT('IGBAUD,IGUNIT,NCPREP = ',3I8)
20531        CALL DPWRST('XXX','BUG ')
20532        WRITE(ICOUT,56)IBUGG4,ISUBG4,IERRG4
20533   56   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
20534        CALL DPWRST('XXX','BUG ')
20535        WRITE(ICOUT,61)IPPDE1,IPPDE2
20536   61   FORMAT('IPPDE1,IPPDE2 = ',A4,2X,A4)
20537        CALL DPWRST('XXX','BUG ')
20538        IF(NCPREP.GT.0)THEN
20539          DO63I=1,NCPREP
20540            WRITE(ICOUT,64)I,ICPREP(I:I)
20541   64       FORMAT('I,ICPREP(I:I) = ',I8,2X,A1,4X)
20542            CALL DPWRST('XXX','BUG ')
20543   63     CONTINUE
20544        ENDIF
20545      ENDIF
20546C
20547C               ********************************************
20548C               **  STEP 0--                              **
20549C               **  IF CALLED FOR, WRITE OUT              **
20550C               **  A USER-DEFINED PRE-PLOT LINE          **
20551C               ********************************************
20552C
20553      IF(IPPDE1.EQ.'ANY' .OR. IPPDE1.EQ.'ALL')THEN
20554        IF(NCPREP.GE.1)THEN
20555          NCSTR=NCPREP
20556          IF(NCSTR.GT.40)NCSTR=40
20557          ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
20558          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20559        ENDIF
20560      ENDIF
20561C
20562C               ********************************************
20563C               **  STEP 1--                              **
20564C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
20565C               **  AND THE MODEL                         **
20566C               ********************************************
20567C
20568      IF(IMANUF.EQ.'QWIN')THEN
20569        GOTO4700
20570      ELSEIF(IMANUF.EQ.'POST')THEN
20571        GOTO8600
20572      ELSEIF(IMANUF.EQ.'X11 ')THEN
20573        GOTO9600
20574      ELSEIF(IMANUF.EQ.'AQUA')THEN
20575        GOTO13500
20576      ELSEIF(IMANUF.EQ.'GENE')THEN
20577        IF(IMODEL.EQ.'CODE')GOTO3200
20578        IF(IMODEL.EQ.'CGM')GOTO3300
20579        IF(IMODEL.EQ.'CGMB')GOTO3400
20580        GOTO3100
20581      ELSEIF(IMANUF.EQ.'SVG ')THEN
20582        GOTO16000
20583      ELSEIF(IMANUF.EQ.'GD  ')THEN
20584        GOTO12000
20585      ELSEIF(IMANUF.EQ.'LATE')THEN
20586        GOTO15000
20587      ELSEIF(IMANUF.EQ.'CAIR')THEN
20588        GOTO17000
20589      ELSEIF(IMANUF.EQ.'D3  ')THEN
20590        GOTO19000
20591      ELSEIF(IMANUF.EQ.'WMF ')THEN
20592        GOTO18000
20593      ELSEIF(IMANUF.EQ.'OPGL')THEN
20594        GOTO4800
20595      ELSEIF(IMANUF.EQ.'TEKT')THEN
20596        GOTO1100
20597      ELSEIF(IMANUF.EQ.'HP')THEN
20598        IF(IMODEL.EQ.'7221')GOTO2100
20599        IF(IMODEL.EQ.'2622')GOTO2300
20600        IF(IMODEL.EQ.'2623')GOTO2300
20601        IF(IMODEL.EQ.'2627')GOTO2300
20602        IF(IMODEL.EQ.'2647')GOTO2300
20603        GOTO2200
20604      ELSEIF(IMANUF.EQ.'LIBP')THEN
20605        GOTO2600
20606      ELSEIF(IMANUF.EQ.'REGI')THEN
20607        GOTO8100
20608      ELSEIF(IMANUF.EQ.'GKS ')THEN
20609        GOTO11000
20610      ELSEIF(IMANUF.EQ.'LAHE')THEN
20611        IF(IMODEL.EQ.'INTE')GOTO4900
20612        IF(IMODEL.EQ.'WINT')GOTO4950
20613        GOTO4600
20614      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
20615        GOTO13000
20616      ELSEIF(IMANUF.EQ.'QUIC')THEN
20617        GOTO9100
20618      ELSEIF(IMANUF.EQ.'CALC')THEN
20619        GOTO4100
20620      ELSEIF(IMANUF.EQ.'ZETA')THEN
20621        GOTO5100
20622      ELSEIF(IMANUF.EQ.'TURB')THEN
20623        GOTO10000
20624      ELSEIF(IMANUF.EQ.'SUN ')THEN
20625        GOTO6600
20626      ENDIF
20627      GOTO9000
20628C
20629C               ******************************************************
20630C               **  STEP 11--                                       **
20631C               **  TREAT THE TEKTRONIX 4662 CASE (A PENPLOTTER)--  **
20632C               **  TO TURN IT ON,                                  **
20633C               **  WRITE OUT AN ESCAPE A E  .                      **
20634C               ******************************************************
20635C
20636 1100 CONTINUE
20637C
20638      IF(IPPDE1.EQ.'TEKT')THEN
20639        IF(NCPREP.GE.1)THEN
20640          NCSTR=NCPREP
20641          IF(NCSTR.GT.40)NCSTR=40
20642          ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
20643          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20644        ENDIF
20645      ENDIF
20646      GOTO9000
20647C
20648C               ******************************************************
20649C               **  STEP 21--                                       **
20650C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
20651C               **  (WITH PACKED BINARY)                            **
20652C               **  (MULTI-COLOR PENPLOTTER)                        **
20653C               **  TO TURN IT ON,                                  **
20654C               **  SEND ESCAPE PERIOD LEFT-PARENTHESIS             **
20655C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
20656C               **             OPERATING AND PROGRAMMING MANUAL,    **
20657C               **             PAGE 72, 221-249.                    **
20658C               **  ALLOW GRAPH LIMITS ON THE PLOTTER TO            **
20659C               **  TAKE ON HARDWARE DEFAULT                        **
20660C               **  (X = 520 TO 15720 MACHINE UNITS                 **
20661C               **  AND Y = 380 TO 10380 MACHINE UNITS).            **
20662C               **  BY PURPOSELY NOT SETTING THE GRAPH LIMITS,      **
20663C               **  THIS WILL ALLOW THE USER TO MANUALLY            **
20664C               **  CHANGE LIMITS BY THE PLOTTER BUTTONS            **
20665C               **  SO AS TO ACCOMODATE DIFFERENT SIZE PAPER.       **
20666C               **  ALSO ALLOW THE PLOTTER UNITS                    **
20667C               **  (= PLOTTER "RESOLUTION") TO                     **
20668C               **  TAKE ON THE HARDWARE DEFAULT WHICH IS           **
20669C               **  3040 UNITS IN THE X DIRECTION AND               **
20670C               **  2000 UNITS IN THE Y DIRECTION                   **
20671C               ******************************************************
20672C
20673 2100 CONTINUE
20674C
20675      IF(IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'7221')THEN
20676        IF(NCPREP.GE.1)THEN
20677          NCSTR=NCPREP
20678          IF(NCSTR.GT.40)NCSTR=40
20679          ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
20680          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20681        ENDIF
20682      ENDIF
20683C
20684      ICSTR(1:8)='+Z.YZ.(:'
20685      ICSTR(2:2)=IESCC
20686      ICSTR(5:5)=IESCC
20687      NCSTR=8
20688      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20689      ICSTR(1:5)='+Z.J:'
20690      ICSTR(2:2)=IESCC
20691      NCSTR=5
20692      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20693      ICSTR(1:25)='+Z.M0050;010;010;013;000:'
20694      ICSTR(2:2)=IESCC
20695      NCSTR=25
20696      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20697      ICSTR(1:21)='+Z.I0080;000;017;000:'
20698      ICSTR(2:2)=IESCC
20699      NCSTR=21
20700      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20701      ICSTR(1:17)='+Z.N0010;019;000:'
20702      ICSTR(2:2)=IESCC
20703      NCSTR=17
20704      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20705      ICSTR(1:13)='+Z.@9999;002:'
20706      ICSTR(2:2)=IESCC
20707      NCSTR=13
20708      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20709      GOTO9000
20710C
20711C               ******************************************************
20712C               **  STEP 22--                                       **
20713C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
20714C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
20715C               **  (MULTI-COLOR PENPLOTTERS)                       **
20716C               **  THERE IS NO    TURN ON    INSTRUCTION PER SE,   **
20717C               **  BUT TO INITIALIZE IT,                           **
20718C               **  SEND    IN                                      **
20719C               **  (WITH A TRAILING SEMI-COLON WHICH IS THE        **
20720C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
20721C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
20722C               **             OPERATING AND PROGRAMMING MANUAL,    **
20723C               **             PAGE 40, 141.                        **
20724C               **  ALLOW GRAPH LIMITS ON THE PLOTTER TO            **
20725C               **  TAKE ON HARDWARE DEFAULT                        **
20726C               **  (X = 520 TO 15720 MACHINE UNITS                 **
20727C               **  AND Y = 380 TO 10380 MACHINE UNITS).            **
20728C               **  BY PURPOSELY NOT SETTING THE GRAPH LIMITS,      **
20729C               **  THIS WILL ALLOW THE USER TO MANUALLY            **
20730C               **  CHANGE LIMITS BY THE PLOTTER BUTTONS            **
20731C               **  SO AS TO ACCOMODATE DIFFERENT SIZE PAPER.       **
20732C               **  ALSO ALLOW THE PLOTTER UNITS                    **
20733C               **  (= PLOTTER "RESOLUTION") TO                     **
20734C               **  TAKE ON THE HARDWARE DEFAULT WHICH IS           **
20735C               **  3040 UNITS IN THE X DIRECTION AND               **
20736C               **  2000 UNITS IN THE Y DIRECTION                   **
20737C               ******************************************************
20738C
20739 2200 CONTINUE
20740C
20741      IF(IPPDE1.EQ.'HPGL' .OR. IPPDE1.EQ.'HP-G' .OR.
20742     1  (IPPDE1.EQ.'HP'.AND.IPPDE2.EQ.'GL') .OR.
20743     1  (IPPDE1.EQ.'HP'.AND.IPPDE2.EQ.'GL+'))THEN
20744        IF(NCPREP.GE.1)THEN
20745          NCSTR=NCPREP
20746          IF(NCSTR.GT.40)NCSTR=40
20747          ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
20748          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20749        ENDIF
20750      ENDIF
20751C
20752C     THE FOLLOWING WAS A SUGGESTED AUGMENTATION (NBS'S YONG-KI KIM,
20753C     MARCH, 1985) WHEN THE PLOTTER IS CONNECTED IN SERIES BETWEEN THE
20754C     HOST AND THE TERMINAL, AND THE PLOTTER NEEDS TO BE PUT IN A
20755C     LISTEN-AND-CAPTURE MODE WHEN GENERATING A PLOT.  TO SPECIFY THIS,
20756C     THE ANALYST ENTERS THE COMMAND        HP-GL +
20757C     RATHER THAN THE USUAL     HP-GL
20758C
20759C     THE FOLLOWING WAS COMMENTED OUT
20760C     ON THE SUGGESTION OF PETER VERDIER (DEC., 1984)
20761C
20762CCCCC ICSTR(1:3)='IN;'
20763CCCCC NCSTR=3
20764CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20765C
20766      GOTO9000
20767C
20768C               **********************************************************
20769C               **  STEP 23--                                           **
20770C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
20771C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
20772C               **  (MONOCHROME DISPLAY TERMINALS)                      **
20773C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
20774C               **             REFERENCE MANUAL,                        **
20775C               **             PAGE 10-3, XXX.                          **
20776C               **********************************************************
20777C
20778 2300 CONTINUE
20779C
20780      IF((IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2622') .OR.
20781     1  (IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2623')  .OR.
20782     1  (IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2627')  .OR.
20783     1  (IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2647'))THEN
20784        IF(NCPREP.GE.1)THEN
20785          NCSTR=NCPREP
20786          IF(NCSTR.GT.40)NCSTR=40
20787          ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
20788          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20789        ENDIF
20790      ENDIF
20791      GOTO9000
20792C
20793C               **********************************************************
20794C               **  STEP 26--                                           **
20795C               **  TREAT THE UNIX LIBPLOT              CASE            **
20796C               **********************************************************
20797C
20798 2600 CONTINUE
20799      GOTO9000
20800C
20801C               ******************************************************
20802C               **  STEP 31--                                       **
20803C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
20804C               ******************************************************
20805C
20806 3100 CONTINUE
20807C
20808      IF(IPPDE1.EQ.'GENE' .AND. NCPREP.GE.1)THEN
20809        NCSTR=NCPREP
20810        IF(NCSTR.GT.40)NCSTR=40
20811        ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
20812        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20813      ENDIF
20814C
20815      ICSTR(1:11)='OPEN DEVICE'
20816      NCSTR=11
20817      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20818      GOTO9000
20819C
20820C               ***************************************************************
20821C               **  STEP 32--                                                **
20822C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
20823C               ***************************************************************
20824C
20825 3200 CONTINUE
20826C
20827      IF(IPPDE1.EQ.'CODE' .AND. NCPREP.GE.1)THEN
20828        NCSTR=NCPREP
20829        IF(NCSTR.GT.40)NCSTR=40
20830        ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
20831        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20832      ENDIF
20833C
20834      ICSTR(1:4)='OPDE'
20835      NCSTR=4
20836      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20837      GOTO9000
20838C
20839C               ***************************************************************
20840C               **  STEP 33--                                                **
20841C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
20842C               ***************************************************************
20843C
20844 3300 CONTINUE
20845C
20846      IF(IPPDE1.EQ.'CGM ' .AND. NCPREP.GE.1)THEN
20847        NCSTR=NCPREP
20848        IF(NCSTR.GT.40)NCSTR=40
20849        ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
20850        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20851      ENDIF
20852      GOTO9000
20853C
20854C               ***************************************************
20855C               **  STEP 34--                                    **
20856C               **  TREAT THE CGM (BINARY)                 CASE  **
20857C               ***************************************************
20858C
20859 3400 CONTINUE
20860      GOTO9000
20861C
20862C               ******************************************************
20863C               **  STEP 41--                                       **
20864C               **  TREAT THE CALCOMP XXXXXX CASE                   **
20865C               **  TO TURN IT ON--                                 **
20866C               **  USE THE CALCOMP LIBRARY ROUTINES                **
20867C               **  (NULL ROUTINE)                                  **
20868C               **  REFERENCE--XX                                   **
20869C               **             XX                                   **
20870C               **             PAGES XX AND XX                      **
20871C               ******************************************************
20872C
20873 4100 CONTINUE
20874      GOTO9000
20875C
20876C               ******************************************************
20877C               **  STEP 46--                                       **
20878C               **  TREAT THE LAHEY   XXXXXX CASE                   **
20879C               **  REFERENCE--Programmer's Reference, Revision C   **
20880C               **             Lahey Computer Systems, January, 1992**
20881C               **             PAGES 51 THRU 65                     **
20882C               ******************************************************
20883C
20884 4600 CONTINUE
20885      IF(ILAHSW.EQ.'OFF')THEN
20886        IX1=0
20887        IF(ILAHGR.EQ.'BIOS')THEN
20888          IX2=0
20889        ELSEIF(ILAHGR.EQ.'DIRE')THEN
20890          IX2=1
20891        ELSE
20892          IX2=1
20893        ENDIF
20894        IMODE=0
20895#ifdef HAVE_LAHEY_CALCOMP
20896        CALL PLOTS(IX1,IX2,IMODE)
20897#endif
20898        ILAHSW='ON'
20899      ENDIF
20900      GOTO9000
20901C
20902C               ******************************************************
20903C               **  STEP 47--                                       **
20904C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
20905C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
20906C               ******************************************************
20907C
20908 4700 CONTINUE
20909#ifdef HAVE_QWIN
20910      IRESLT=FOCUSQQ(99)
20911      IRESLT=SETFONT('fh16w8b')
20912      MODESTATUS=GETFONTINFO(MSFONT)
20913      ICHRHT=MSFONT.PIXHEIGHT
20914      ICHRWD=MSFONT.PIXWIDTH
20915      IF(ICHRWD.EQ.0)ICHRWD=MSFONT.AVGWIDTH
20916      IF(ICHRWD.EQ.0)ICHRWD=ICHRHT/2
20917      IRESLT=GETWSIZEQQ(99,QWIN$SIZECURR,WINFO)
20918C
20919      NUMHPP=WINFO.W*ICHRWD
20920      IF(NUMHPP.LE.100)NUMHPP=100
20921      NUMVPP=WINFO.H*ICHRHT
20922      IF(NUMVPP.LE.100)NUMVPP=100
20923      ANUMHP=REAL(NUMHPP)
20924      ANUMVP=REAL(NUMVPP)
20925C
20926      CALL SETVIEWORG(INT2(0),INT2(0),XY)
20927      CALL SETVIEWPORT(INT2(0),INT2(0),INT2(NUMHPP-1),INT2(NUMVPP-1))
20928#endif
20929      GOTO9000
20930C
20931C               ******************************************************
20932C               **  STEP 48--                                       **
20933C               **  TREAT THE OPEN-GL DRIVER                        **
20934C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
20935C               ******************************************************
20936C
20937 4800 CONTINUE
20938#ifdef HAVE_OPEN_GL
20939      CALL GLOPDE()
20940#endif
20941      GOTO9000
20942C
20943C               ******************************************************
20944C               **  STEP 49--                                       **
20945C               **  TREAT THE LAHEY INTERACTOR CASE                 **
20946C               ******************************************************
20947C
20948 4900 CONTINUE
20949      GOTO9000
20950C
20951C               ******************************************************
20952C               **  STEP 49B-                                       **
20953C               **  TREAT THE LAHEY WINTERACTOR CASE                **
20954C               ******************************************************
20955C
20956 4950 CONTINUE
20957#ifdef HAVE_WININTERACTER
20958      IHAND2=1
20959      CALL WindowSelect(IHAND2)
20960#endif
20961      GOTO9000
20962C
20963C
20964C               ******************************************************
20965C               **  STEP 51--                                       **
20966C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
20967C               **  TO TURN IT ON--                                 **
20968C               **  WRITE OUT    ZZZZZZZZZZ                         **
20969C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
20970C               **             MODELS 3600SX AND 3653SX             **
20971C               **             PAGES B-0 AND B-1                    **
20972C               **   USE CALCOMP LIBRARY ROUTINES                   **
20973C               **   NULL ROUTINE                                   **
20974C               ******************************************************
20975C
20976 5100 CONTINUE
20977      GOTO9000
20978C
20979C               ******************************************************
20980C               **  STEP 66--                                       **
20981C               **  TREAT THE SUN CASE                              **
20982C               ******************************************************
20983C
20984 6600 CONTINUE
20985      IF(IPPDE1.EQ.'SUN' .AND. NCPREP.GE.1)THEN
20986        NCSTR=NCPREP
20987        IF(NCSTR.GT.40)NCSTR=40
20988        ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
20989        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
20990      ENDIF
20991C
20992      GOTO9000
20993C
20994C               ******************************************************
20995C               **  STEP 81--                                       **
20996C               **  TREAT THE DEC  REGIS CASE                       **
20997C               **  TO OPEN A DEVICE---                             **
20998C               **  WRITE OUT AN XX                                 **
20999C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
21000C               **             PAGES XX AND XXX                     ZZ
21001C               ******************************************************
21002C
21003 8100 CONTINUE
21004C
21005      IF(IPPDE1.EQ.'REGI' .AND. NCPREP.GE.1)THEN
21006        NCSTR=NCPREP
21007        IF(NCSTR.GT.40)NCSTR=40
21008        ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
21009        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
21010      ENDIF
21011C
21012      GOTO9000
21013C
21014C               ******************************************************
21015C               **  STEP 86                                         **
21016C               **  TREAT THE POSTSCRIPT CASE                       **
21017C               **  SINCE POSTSCRIPT IS A PAGE ORIENTATED LANGUAGE, **
21018C               **  SET PAGE PARAMETERS IN GRERSC (ERASE SCREEN)    **
21019C               **  REFERENCE - POSTSCRIPT LANGUAGE TUTORIAL AND    **
21020C               **  COOKBOOK FROM ADOBE SYSTEMS, CHAPTER 6          **
21021C               ******************************************************
21022C
21023 8600 CONTINUE
21024C
21025      IF(IPPDE1.EQ.'POST' .AND. NCPREP.GE.1)THEN
21026        NCSTR=NCPREP
21027        IF(NCSTR.GT.40)NCSTR=40
21028        ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
21029        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
21030      ENDIF
21031C
21032      GOTO9000
21033C
21034C               ******************************************************
21035C               **  STEP 91                                         **
21036C               **  TREAT THE QUIC CASE                             **
21037C               **  1) SET ORIENTATION - LANDSCAPE "^IOL"           **
21038C               **                       PORTRAIT  "^IOP"           **
21039C               **  2) SET MARGIN      - HORIZONTAL "^IHMlllllrrrrr **
21040C               **                     - VERTICAL   "^IVMtttttbbbbb **
21041C               **     NOTE: MARGINS WILL BE ENFORCED BY THE "OFFSET"*
21042C               **           AND NUMBER OF PICTURE POINTS.  USING   **
21043C               **           IHM, IHV CAUSES A FORM FEED WHEN IT IS **
21044C               **           REACHED.  WE ONLY WANT TO CLIP, NOT    **
21045C               **           START A NEW PAGE.                      **
21046C               **  REFERENCE: QUIC PROGRAMMING MANUAL FROM QMS     **
21047C               ******************************************************
21048C
21049 9100 CONTINUE
21050C
21051      IF(IPPDE1.EQ.'QUIC' .AND. NCPREP.GE.1)THEN
21052        NCSTR=NCPREP
21053        IF(NCSTR.GT.40)NCSTR=40
21054        ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
21055        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
21056      ENDIF
21057C
21058      CALL DPCONA(94,ICARAT)
21059      ICSTR(1:1)=ICARAT
21060      ICSTR(2:4)='IOL'
21061C
21062      IF(IORNSW.EQ.'PORT')THEN
21063        ICSTR(4:4)='P'
21064        IX2=8500
21065        IY2=11000
21066      ELSE
21067        IX2=11000
21068        IY2=8500
21069      ENDIF
21070C
21071      ICSTR(5:5)=ICARAT
21072      ICSTR(6:8)='IMH'
21073      IX=0
21074      IY=0
21075      NCSTR=8
21076      NCHTOT=-5
21077      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
21078      CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR)
21079      ICSTR(19:19)=ICARAT
21080      ICSTR(20:22)='IMV'
21081      NCSTR=22
21082      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
21083      CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR)
21084      NCSTR=32
21085      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
21086C
21087      GOTO9000
21088C
21089C               ******************************************************
21090C               **  STEP 96--                                       **
21091C               **  TREAT THE X11        CASE                       **
21092C               ******************************************************
21093C
21094 9600 CONTINUE
21095      IF(IPPDE1.EQ.'X11 ' .AND. NCPREP.GE.1)THEN
21096        NCSTR=NCPREP
21097        IF(NCSTR.GT.40)NCSTR=40
21098        ICSTR(1:NCSTR)=ICPREP(1:NCSTR)
21099        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
21100      ENDIF
21101      GOTO9000
21102C
21103CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
21104C               *************************************************
21105C               **  STEP 100--                                 **
21106C               **  TREAT THE VGA VIA TURBO-C       CASE       **
21107C               *************************************************
21108C
2110910000 CONTINUE
21110CTURB CALL TCOPDE
21111      GOTO9000
21112C
21113C               ******************************************************
21114C               **  STEP 110--                                      **
21115C               **  TREAT THE GKS                DRIVER             **
21116C               ******************************************************
21117C
2111811000 CONTINUE
21119      GOTO9000
21120C
21121C               ******************************************************
21122C               **  STEP 120--                                      **
21123C               **  TREAT THE GD                     DRIVER         **
21124C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
21125C               **  1) JPEG                                         **
21126C               **  2) PNG                                          **
21127C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
21128C               ******************************************************
21129C
2113012000 CONTINUE
21131      GOTO9000
21132C
21133C               ******************************************************
21134C               **  STEP 130--                                      **
21135C               **  TREAT THE ABSOFT                 DRIVER         **
21136C               ******************************************************
21137C
2113813000 CONTINUE
21139      GOTO9000
21140C
21141C               ******************************************************
21142C               **  STEP 135--                                      **
21143C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
21144C               ******************************************************
21145C
21146C  NOTE: DO NOTHING HERE. SETUP NEXT PLOT IN GRERSC ROUTINE.
21147C
2114813500 CONTINUE
21149      GOTO9000
21150C
21151C               ******************************************************
21152C               **  STEP 150--                                      **
21153C               **  TREAT THE LATEX (EEPIC)                  DRIVER **
21154C               ******************************************************
21155C
2115615000 CONTINUE
21157      GOTO9000
21158C
21159C               ******************************************************
21160C               **  STEP 160--                                      **
21161C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
21162C               ******************************************************
21163C
2116416000 CONTINUE
21165      GOTO9000
21166C
21167C               ******************************************************
21168C               **  STEP 170--                                      **
21169C               **  TREAT THE CAIRO                          DRIVER **
21170C               ******************************************************
21171C
2117217000 CONTINUE
21173      GOTO9000
21174C
21175C               ******************************************************
21176C               **  STEP 180--                                      **
21177C               **  TREAT THE WMF                            DRIVER **
21178C               ******************************************************
21179C
2118018000 CONTINUE
21181      GOTO9000
21182C
21183C               ******************************************************
21184C               **  STEP 190--                                      **
21185C               **  TREAT THE D3                             DRIVER **
21186C               ******************************************************
21187C
2118819000 CONTINUE
21189      GOTO9000
21190C
21191C               *****************
21192C               **  STEP 90--  **
21193C               **  EXIT       **
21194C               *****************
21195C
21196 9000 CONTINUE
21197      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'OPDE')THEN
21198        WRITE(ICOUT,999)
21199        CALL DPWRST('XXX','BUG ')
21200        WRITE(ICOUT,9011)
21201 9011   FORMAT('***** AT THE END       OF GROPDE--')
21202        CALL DPWRST('XXX','BUG ')
21203        WRITE(ICOUT,9023)NCSTR,NCPREP,IERRG4
21204 9023   FORMAT('NCSTR,NCPREP,IERRG4 = ',2I8,2X,A4)
21205        CALL DPWRST('XXX','BUG ')
21206        IF(NCSTR.GT.0)THEN
21207          DO9025I=1,NCSTR
21208            CALL DPCOAN(ICSTR(I:I),IASCNE)
21209            WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
21210 9026       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
21211            CALL DPWRST('XXX','BUG ')
21212 9025     CONTINUE
21213        ENDIF
21214        WRITE(ICOUT,9031)IPPDE1,IPPDE2
21215 9031   FORMAT('IPPDE1,IPPDE2 = ',A4,2X,A4)
21216        CALL DPWRST('XXX','BUG ')
21217        IF(NCPREP.GT.0)THEN
21218          DO9033I=1,NCPREP
21219            WRITE(ICOUT,9034)I,ICPREP(I:I)
21220 9034       FORMAT('I,ICPREP(I:I) = ',I8,2X,A1,4X)
21221            CALL DPWRST('XXX','BUG ')
21222 9033     CONTINUE
21223        ENDIF
21224      ENDIF
21225C
21226      RETURN
21227      END
21228      SUBROUTINE GRRESC(PXCOOR,PYCOOR)
21229C
21230C     PURPOSE--READ SCREEN COORDINATES ON A SPECIFIC GRAPHICS DEVICE
21231C
21232C     WRITTEN BY--JAMES J. FILLIBEN
21233C                 STATISTICAL ENGINEERING DIVISION
21234C                 INFORMATION TECHNOLOGY LABORATORY
21235C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
21236C                 GAITHERSBURG, MD 20899-8980
21237C                 PHONE--301-975-2855
21238C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
21239C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
21240C     LANGUAGE--ANSI FORTRAN (1977)
21241C     VERSION NUMBER--83.6
21242C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
21243C     UPDATED         --JANUARY    1989. SUN (BY BILL ANDERSON)
21244C     UPDATED         --JANUARY    1989. POSTSCRIPT (BY ALAN HECKERT)
21245C     UPDATED         --JANUARY    1989. CGM (BY ALAN HECKERT)
21246C     UPDATED         --JANUARY    1989. QMS QUIC (BY ALAN HECKERT)
21247C     UPDATED         --JANUARY    1989. CALCOMP (BY ALAN HECKERT)
21248C     UPDATED         --JANUARY    1989. ZETA (BY ALAN HECKERT)
21249C     UPDATED         --APRIL      1989. SOFT-CODE BACKSLASH FOR UNIX
21250C     UPDATED         --MARCH      1990. X11 (BY ALAN HECKERT)
21251C     UPDATED         --MAY        1991. RENUMBER TOP BRANCHES (JJF)
21252C     UPDATED         --MAY        1991. VGA/TURBOC DRIVER (JJF)
21253C     UPDATED         --JULY       1996. LAHEY (ALAN)
21254C     UPDATED         --OCTOBER    1996. MICROSOFT QWIN (ALAN)
21255C     UPDATED         --SEPTEMBER  2007. SUPPORT FOR AQUATERM
21256C     UPDATED         --APRIL      2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
21257C                                        (THESE WERE NEVER ACTUALLY IMPLEMENTED)
21258C
21259C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
21260C
21261#ifdef HAVE_QWIN
21262CQWIN USE DFLIB
21263      USE IFQWIN
21264#endif
21265C
21266      CHARACTER*1 IBCH
21267      CHARACTER*1 IBHIX
21268      CHARACTER*1 IBLOX
21269      CHARACTER*1 IBHIY
21270      CHARACTER*1 IBLOY
21271C
21272      CHARACTER*130 ICSTR
21273      CHARACTER*4 ISUBN0
21274C
21275C-----COMMON----------------------------------------------------------
21276C
21277      INCLUDE 'DPCOPA.INC'
21278      INCLUDE 'DPCOGR.INC'
21279      INCLUDE 'DPCOHO.INC'
21280      INCLUDE 'DPCONP.INC'
21281      INCLUDE 'DPCOBE.INC'
21282      INCLUDE 'DPCODV.INC'
21283      INCLUDE 'DPCOF2.INC'
21284      INCLUDE 'DPCOP2.INC'
21285C
21286C-----START POINT-----------------------------------------------------
21287C
21288      ISUBN0='RESC'
21289      IERRG4='NO'
21290C
21291      NCSTR=(-999)
21292C
21293      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')THEN
21294        WRITE(ICOUT,999)
21295  999   FORMAT(1X)
21296        CALL DPWRST('XXX','BUG ')
21297        WRITE(ICOUT,51)
21298   51   FORMAT('***** AT THE BEGINNING OF GRRESC--')
21299        CALL DPWRST('XXX','BUG ')
21300        WRITE(ICOUT,53)IMANUF,IMODEL,IBUGG4,IGUNIT
21301   53   FORMAT('IMANUF,IMODEL,IBUGG4,IGUNIT = ',3(A4,2X),I8)
21302        CALL DPWRST('XXX','BUG ')
21303        WRITE(ICOUT,56)NUMHPP,NUMVPP,ANUMHP,ANUMVP
21304   56   FORMAT('NUMHPP,NUMVPP,ANUMHP,ANUMVP = ',2I8,2G15.7)
21305        CALL DPWRST('XXX','BUG ')
21306        WRITE(ICOUT,57)PXCOOR,PYCOOR
21307   57   FORMAT('PXCOOR,PYCOOR = ',2G15.7)
21308        CALL DPWRST('XXX','BUG ')
21309      ENDIF
21310C
21311C               ********************************************
21312C               **  STEP 1--                              **
21313C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
21314C               **  AND THE MODEL                         **
21315C               ********************************************
21316C
21317      IF(IMANUF.EQ.'QWIN')THEN
21318        GOTO4700
21319      ELSEIF(IMANUF.EQ.'POST')THEN
21320        GOTO8600
21321      ELSEIF(IMANUF.EQ.'X11 ')THEN
21322        GOTO9600
21323      ELSEIF(IMANUF.EQ.'AQUA')THEN
21324        GOTO13500
21325      ELSEIF(IMANUF.EQ.'GENE')THEN
21326        IF(IMODEL.EQ.'CODE')GOTO3200
21327        IF(IMODEL.EQ.'CGM')GOTO3300
21328        IF(IMODEL.EQ.'CGMB')GOTO3400
21329        GOTO3100
21330      ELSEIF(IMANUF.EQ.'SVG ')THEN
21331        GOTO16000
21332      ELSEIF(IMANUF.EQ.'GD  ')THEN
21333        GOTO12000
21334      ELSEIF(IMANUF.EQ.'LATE')THEN
21335        GOTO15000
21336      ELSEIF(IMANUF.EQ.'CAIR')THEN
21337        GOTO17000
21338      ELSEIF(IMANUF.EQ.'D3  ')THEN
21339        GOTO19000
21340      ELSEIF(IMANUF.EQ.'WMF ')THEN
21341        GOTO18000
21342      ELSEIF(IMANUF.EQ.'OPGL')THEN
21343        GOTO4800
21344      ELSEIF(IMANUF.EQ.'TEKT')THEN
21345        IF(IMODEL.EQ.'4662')GOTO9000
21346        GOTO1100
21347      ELSEIF(IMANUF.EQ.'HP')THEN
21348        IF(IMODEL.EQ.'7221')GOTO2100
21349        IF(IMODEL.EQ.'2622')GOTO2300
21350        IF(IMODEL.EQ.'2623')GOTO2300
21351        IF(IMODEL.EQ.'2627')GOTO2300
21352        IF(IMODEL.EQ.'2647')GOTO2300
21353        GOTO2200
21354      ELSEIF(IMANUF.EQ.'LIBP')THEN
21355        GOTO2600
21356      ELSEIF(IMANUF.EQ.'REGI')THEN
21357        GOTO8100
21358      ELSEIF(IMANUF.EQ.'GKS ')THEN
21359        GOTO11000
21360      ELSEIF(IMANUF.EQ.'LAHE')THEN
21361        IF(IMODEL.EQ.'INTE')GOTO4900
21362        IF(IMODEL.EQ.'WINT')GOTO4950
21363        GOTO4600
21364      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
21365        GOTO13000
21366      ELSEIF(IMANUF.EQ.'QUIC')THEN
21367        GOTO9100
21368      ELSEIF(IMANUF.EQ.'CALC')THEN
21369        GOTO4100
21370      ELSEIF(IMANUF.EQ.'ZETA')THEN
21371        GOTO5100
21372      ELSEIF(IMANUF.EQ.'TURB')THEN
21373        GOTO10000
21374      ELSEIF(IMANUF.EQ.'SUN ')THEN
21375        GOTO6600
21376      ENDIF
21377      GOTO9000
21378C
21379C               ************************************************************
21380C               **  STEP 11--                                             **
21381C               **  TREAT THE TEKTRONIX 400X, 401X, 405X, AND 4114 CASES  **
21382C               **  (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES)      **
21383C               **  TO READ THE SCREEN,                                   **
21384C               **  WRITE OUT AN ESCAPE SUB                               **
21385C               ************************************************************
21386C
21387 1100 CONTINUE
21388      IFACTO=4
21389      IF(NUMHPP.GE.4000)IFACTO=1
21390C
21391      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')THEN
21392        WRITE(ICOUT,1111)
21393 1111   FORMAT('IN GRRESC, ABOUT TO ENTER GRKICR...')
21394        CALL DPWRST('XXX','BUG ')
21395      ENDIF
21396      CALL GRKICR
21397C
21398      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')THEN
21399        WRITE(ICOUT,1112)
21400 1112   FORMAT('IN GRRESC, ABOUT TO WRITE OUT ESCAPE SUB...')
21401        CALL DPWRST('XXX','BUG ')
21402      ENDIF
21403C
21404      NCSTR=0
21405      IF(IHOST1.EQ.'VAX')THEN
21406        NCSTR=NCSTR+1
21407        ICSTR(NCSTR:NCSTR)='$'
21408      ENDIF
21409      NCSTR=NCSTR+1
21410      ICSTR(NCSTR:NCSTR)=' '
21411      NCSTR=NCSTR+1
21412      ICSTR(NCSTR:NCSTR)=ISYNC
21413      NCSTR=NCSTR+1
21414      ICSTR(NCSTR:NCSTR)=IESCC
21415      NCSTR=NCSTR+1
21416      ICSTR(NCSTR:NCSTR)=ISUBC
21417      NCSTR=NCSTR+1
21418      ICSTR(NCSTR:NCSTR)=IUSC
21419      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
21420C
21421      READ(IRDGR,1122)IBCH,IBHIX,IBLOX,IBHIY,IBLOY
21422 1122 FORMAT(5A1)
21423C
21424      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')THEN
21425        WRITE(ICOUT,1123)
21426 1123   FORMAT('IN GRRESC, ABOUT TO ENTER GRKICR...')
21427        CALL DPWRST('XXX','BUG ')
21428      ENDIF
21429      CALL GRRECR
21430C
21431      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')THEN
21432        WRITE(ICOUT,1124)
21433 1124   FORMAT('IN GRRESC, AFTER READING SCREEN...')
21434        CALL DPWRST('XXX','BUG ')
21435        WRITE(ICOUT,1125)IBCH,IBHIX,IBLOX,IBHIY,IBLOY
21436 1125   FORMAT('IBCH,IBHIX,IBLOX,IBUTE4,IBLOY = ',5A1)
21437        CALL DPWRST('XXX','BUG ')
21438        WRITE(ICOUT,1126)
21439 1126   FORMAT('IN GRRESC, ABOUT TO ENTER GRTRBY...')
21440        CALL DPWRST('XXX','BUG ')
21441      ENDIF
21442      CALL TKTRBY(IBHIX,IBLOX,IBHIY,IBLOY,IFACTO,IXCOOR,IYCOOR)
21443C
21444      XCOOR=IXCOOR
21445      YCOOR=IYCOOR
21446      PXCOOR=100.0*(XCOOR/ANUMHP)
21447      PYCOOR=100.0*(YCOOR/ANUMVP)
21448C
21449      GOTO9000
21450C
21451C               ******************************************************
21452C               **  STEP 12--                                       **
21453C               **  TREAT THE TEKTRONIX 4020, 4022, AND 4025 CASES  **
21454C               **  (NON-COLOR RASTER DEVICES).                     **
21455C               **  TO READ THE SCREEN,                             **
21456C               **  USE THE !XXX COMMAND                            **
21457C               **  REFERENCE--4027 OPERATOR'S MANUAL, PAGE B-3.    **
21458C               ******************************************************
21459C
21460C1200 CONTINUE
21461CCCCC WRITE(IGUNIT,1210)
21462C1210 FORMAT('!XXX;')
21463CCCCC GOTO9000
21464C1290 CONTINUE
21465C
21466C               ******************************************************
21467C               **  STEP 21--                                       **
21468C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
21469C               **  (MULTI-COLOR PENPLOTTER)                        **
21470C               **  THERE IS NO   READ SCREEN  INSTRUCTION PER SE.  **
21471C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
21472C               **             OPERATING AND PROGRAMMING MANUAL,    **
21473C               **             PAGE XX.                             **
21474C               ******************************************************
21475C
21476 2100 CONTINUE
21477      GOTO9000
21478C
21479C               ******************************************************
21480C               **  STEP 22--                                       **
21481C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
21482C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
21483C               **  (MULTI-COLOR PENPLOTTERS)                       **
21484C               **  THERE IS NO   READ SCREEN  INSTRUCTION PER SE.  **
21485C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
21486C               **             OPERATING AND PROGRAMMING MANUAL,    **
21487C               **             PAGE XX, XXX.                        **
21488C               ******************************************************
21489C
21490 2200 CONTINUE
21491      GOTO9000
21492C
21493C               **********************************************************
21494C               **  STEP 23--                                           **
21495C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
21496C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
21497C               **  (MONOCHROME DISPLAY TERMINALS)                      **
21498C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
21499C               **             REFERENCE MANUAL,                        **
21500C               **             PAGE XX-X, XXX.                          **
21501C               **********************************************************
21502C
21503 2300 CONTINUE
21504      ICSTR(1:1)=IESCC
21505C
21506      ICSTR(2:5)='*dkZ'
21507      NCSTR=5
21508      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
21509C
21510      ICSTR(2:5)='*s4^'
21511      NCSTR=5
21512      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
21513C
21514      READ(IRD,2311)IXCOOR,IYCOOR
21515 2311 FORMAT(I6,1X,I6)
21516      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')THEN
21517        WRITE(ICOUT,2312)IXCOOR,IYCOOR
21518 2312   FORMAT('IXCOOR,IYCOOR = ',2I8)
21519        CALL DPWRST('XXX','BUG ')
21520      ENDIF
21521C
21522      XCOOR=IXCOOR
21523      YCOOR=IYCOOR
21524      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')THEN
21525        WRITE(ICOUT,2313)XCOOR,YCOOR,ANUMHP,ANUMVP
21526 2313   FORMAT('XCOOR,YCOOR,ANUMHP,ANUMVP = ',4E15.7)
21527        CALL DPWRST('XXX','BUG ')
21528      ENDIF
21529C
21530      PXCOOR=100.0*(XCOOR/ANUMHP)
21531      PYCOOR=100.0*(YCOOR/ANUMVP)
21532      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')THEN
21533        WRITE(ICOUT,2314)PXCOOR,PYCOOR
21534 2314   FORMAT('PXCOOR,PYCOOR = ',2E15.7)
21535        CALL DPWRST('XXX','BUG ')
21536      ENDIF
21537C
21538      ICSTR(2:5)='*dlZ'
21539      NCSTR=5
21540      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
21541C
21542      GOTO9000
21543C
21544C               ******************************************************
21545C               **  STEP 26--                                       **
21546C               **  TREAT THE UNIX LIBPLOT          CASES           **
21547C               ******************************************************
21548C
21549 2600 CONTINUE
21550      GOTO9000
21551C
21552C               ******************************************************
21553C               **  STEP 31--                                       **
21554C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
21555C               ******************************************************
21556C
21557 3100 CONTINUE
21558      ICSTR(1:11)='READ SCREEN'
21559      NCSTR=11
21560      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
21561      GOTO9000
21562C
21563C               ***************************************************************
21564C               **  STEP 32--                                                **
21565C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
21566C               ***************************************************************
21567C
21568 3200 CONTINUE
21569      ICSTR(1:4)='RESC'
21570      NCSTR=4
21571      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
21572      GOTO9000
21573C
21574C               ***************************************************************
21575C               **  STEP 33--                                                **
21576C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
21577C               **  CGM DOES NOT SUPPORT THIS FEATURE                        **
21578C               ***************************************************************
21579C
21580 3300 CONTINUE
21581      GOTO9000
21582C
21583C               ***************************************************************
21584C               **  STEP 34--                                                **
21585C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
21586C               **  BINARY CASE                                              **
21587C               **  CGM DOES NOT SUPPORT THIS FEATURE                        **
21588C               ***************************************************************
21589C
21590 3400 CONTINUE
21591      GOTO9000
21592C
21593C               ******************************************************
21594C               **  STEP 41--                                       **
21595C               **  TREAT THE CALCOMP XXXXXX CASE                   **
21596C               **  TO READ SCREEN--                                **
21597C               **  WRITE OUT AN XXXXXXXXXX                         **
21598C               **  (NOT DONE)                                      **
21599C               **  REFERENCE--XX                                   **
21600C               **             XX                                   **
21601C               **             PAGES XX AND XX                      **
21602C               ******************************************************
21603C
21604 4100 CONTINUE
21605      GOTO9000
21606C
21607C               ******************************************************
21608C               **  STEP 46--                                       **
21609C               **  TREAT THE LAHEY          CASE                   **
21610C               ******************************************************
21611C
21612 4600 CONTINUE
21613CCCCC CALL WHERE(AX,AY,AFACT)
21614      GOTO9000
21615C
21616C               ******************************************************
21617C               **  STEP 47--                                       **
21618C               **  TREAT THE MICROSOFT QWIN CASE                   **
21619C               ******************************************************
21620C
21621 4700 CONTINUE
21622      WRITE(ICOUT,4711)
21623 4711 FORMAT(1X,'POSITION THE CURSUR VIA THE MOUSE TO THE DESIRED ')
21624      CALL DPWRST('XXX','BUG ')
21625      WRITE(ICOUT,4712)
21626 4712 FORMAT(1X,'LOCATION AND THEN PRESS ANY MOUSE BUTTON')
21627      CALL DPWRST('XXX','BUG ')
21628      IX=0
21629      IY=0
21630#ifdef HAVE_QWIN
21631      IRESLT=FOCUSQQ(99)
21632      MOUSEEVENT = MOUSE$RBUTTONDOWN .OR. MOUSE$LBUTTONDOWN
21633      IRESLT = WAITONMOUSEEVENT(MOUSEEVENT, KEYSTATE, IX, IY)
21634      PXCOOR=100.0*(REAL(IX)/ANUMHP)
21635      PYCOOR=100.0 - 100.0*(REAL(IY)/ANUMVP)
21636      IRESLT=FOCUSQQ(IPR)
21637#endif
21638      GOTO9000
21639C
21640C               ******************************************************
21641C               **  STEP 48--                                       **
21642C               **  TREAT THE OPEN-GL DRIVER                        **
21643C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
21644C               ******************************************************
21645C
21646 4800 CONTINUE
21647      GOTO9000
21648C
21649C               ******************************************************
21650C               **  STEP 49--                                       **
21651C               **  TREAT THE LAHEY INTERACTOR CASE                 **
21652C               ******************************************************
21653C
21654 4900 CONTINUE
21655      GOTO9000
21656C
21657C               ******************************************************
21658C               **  STEP 49B-                                       **
21659C               **  TREAT THE LAHEY WINTERACTOR CASE                **
21660C               ******************************************************
21661C
21662 4950 CONTINUE
21663      GOTO9000
21664C
21665C               ******************************************************
21666C               **  STEP 51--                                       **
21667C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
21668C               **  THERE IS NO   READ SCREEN  INSTRUCTION PER SE.  **
21669C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
21670C               **             MODELS 3600SX AND 3653SX             **
21671C               **             PAGES B-0 AND B-1                    **
21672C               ******************************************************
21673C
21674 5100 CONTINUE
21675      GOTO9000
21676C
21677C               ******************************************************
21678C               **  STEP 66--                                       **
21679C               **  TREAT THE SUN CASE                              **
21680C               ******************************************************
21681C
21682 6600 CONTINUE
21683      GOTO9000
21684C
21685C               ******************************************************
21686C               **  STEP 81--                                       **
21687C               **  TREAT THE DEC  REGIS CASE                       **
21688C               **  TO READ THE SCREEN---                           **
21689C               **  WRITE OUT AN R(P)                               **
21690C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
21691C               **             PAGES 158                            **
21692C               ******************************************************
21693C
21694 8100 CONTINUE
21695      ICSTR(1:1)=IESCC
21696      ICSTR(2:3)='Pp'
21697      NCSTR=3
21698      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
21699C
21700      ICSTR(1:7)='R(P(T))'
21701      NCSTR=7
21702      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
21703C
21704      READ(IRD,8111)IXCOOR,IYCOOR
21705 8111 FORMAT(1X,I3,1X,I3)
21706      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')THEN
21707        WRITE(ICOUT,8112)IXCOOR,IYCOOR
21708 8112   FORMAT('IXCOOR,IYCOOR = ',2I8)
21709        CALL DPWRST('XXX','BUG ')
21710      ENDIF
21711C
21712      XCOOR=IXCOOR
21713      YCOOR=IYCOOR
21714      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')THEN
21715        WRITE(ICOUT,8113)XCOOR,YCOOR,ANUMHP,ANUMVP
21716 8113   FORMAT('XCOOR,YCOOR,ANUMHP,ANUMVP = ',4E15.7)
21717        CALL DPWRST('XXX','BUG ')
21718      ENDIF
21719C
21720      PXCOOR=100.0*(XCOOR/ANUMHP)
21721      PYCOOR=100.0*(YCOOR/ANUMVP)
21722      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')THEN
21723        WRITE(ICOUT,8114)PXCOOR,PYCOOR
21724 8114   FORMAT('PXCOOR,PYCOOR = ',2E15.7)
21725        CALL DPWRST('XXX','BUG ')
21726      ENDIF
21727C
21728      ICSTR(1:1)=IESCC
21729CCCCC THE FOLLOWING LINE WAS FIXED (SOFT-CODE BACKSLASH) APRIL 1989
21730      ICSTR(2:2)=IBASLC
21731      NCSTR=2
21732      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
21733      GOTO9000
21734C
21735C               ******************************************************
21736C               **  STEP 86--                                       **
21737C               **  TREAT THE QUIC       CASE                       **
21738C               ******************************************************
21739C
21740 8600 CONTINUE
21741      GOTO9000
21742C
21743C               ******************************************************
21744C               **  STEP 91--                                       **
21745C               **  TREAT THE POSTSCRIPT CASE                       **
21746C               ******************************************************
21747C
21748 9100 CONTINUE
21749      GOTO9000
21750C
21751C               ******************************************************
21752C               **  STEP 96--                                       **
21753C               **  TREAT THE X11        CASE                       **
21754C               ******************************************************
21755C
21756 9600 CONTINUE
21757#ifdef HAVE_X11
21758      IF(IX11OF.EQ.'OFF')GOTO9000
21759      WRITE(ICOUT,9611)
21760 9611 FORMAT(1X,'POSITION THE CURSUR VIA THE MOUSE TO THE DESIRED ')
21761      CALL DPWRST('XXX','BUG ')
21762      WRITE(ICOUT,9612)
21763 9612 FORMAT(1X,'LOCATION AND THEN PRESS ANY MOUSE BUTTON')
21764      CALL DPWRST('XXX','BUG ')
21765      CALL XRDLOC(IXCOOR,IYCOOR,IXERR)
21766      IF(IXERR.NE.1)THEN
21767        XCOOR=IXCOOR
21768        YCOOR=IYCOOR
21769        PXCOOR=100.0*(XCOOR/ANUMHP)
21770        PYCOOR=100.0*(YCOOR/ANUMVP)
21771        PYCOOR=100.0-PYCOOR
21772      ELSE
21773        WRITE(ICOUT,9621)
21774 9621   FORMAT(1X,'WARNING: X11 WINDOW DESTROYED, NOTHING DONE')
21775        CALL DPWRST('XXX','BUG ')
21776        PXCOOR=0.
21777        PYCOOR=0.
21778      ENDIF
21779C
21780#endif
21781      GOTO9000
21782C
21783C               *************************************************
21784C               **  STEP 100--                                 **
21785C               **  TREAT THE VGA VIA TURBO-C       CASE       **
21786C               *************************************************
21787C
2178810000 CONTINUE
21789CTURB CALL TCRESC(X,Y)
21790      GOTO9000
21791C
21792C               ******************************************************
21793C               **  STEP 110--                                      **
21794C               **  TREAT THE GKS                DRIVER             **
21795C               ******************************************************
21796C
2179711000 CONTINUE
21798      GOTO9000
21799C
21800C               ******************************************************
21801C               **  STEP 120--                                      **
21802C               **  TREAT THE GD                     DRIVER         **
21803C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
21804C               **  1) JPEG                                         **
21805C               **  2) PNG                                          **
21806C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
21807C               ******************************************************
21808C
2180912000 CONTINUE
21810      GOTO9000
21811C
21812C               ******************************************************
21813C               **  STEP 130--                                      **
21814C               **  TREAT THE ABSOFT                 DRIVER         **
21815C               ******************************************************
21816C
2181713000 CONTINUE
21818      GOTO9000
21819C
21820C               ******************************************************
21821C               **  STEP 135--                                      **
21822C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
21823C               ******************************************************
21824C
21825C  NOTE: READ SCREEN NOT CURRENTLY SUPPORTED.
21826C
2182713500 CONTINUE
21828      IF(IAQUOF.EQ.'OFF')GOTO9000
21829#ifdef HAVE_AQUA
21830      WRITE(ICOUT,13511)
2183113511 FORMAT(1X,'POSITION THE CURSUR VIA THE MOUSE TO THE DESIRED ')
21832      CALL DPWRST('XXX','BUG ')
21833      WRITE(ICOUT,13512)
2183413512 FORMAT(1X,'LOCATION AND THEN PRESS ANY MOUSE BUTTON')
21835      CALL DPWRST('XXX','BUG ')
21836      CALL AQRDLO(IXCOOR,IYCOOR,IERR)
21837      IF(IERR.GT.0)THEN
21838        WRITE(ICOUT,13521)
2183913521   FORMAT(1X,'WARNING: NO COORDINATES RETURNED FROM AQUA ',
21840     1         'MOUSE EVENT')
21841        CALL DPWRST('XXX','BUG ')
21842        PXCOOR=0.
21843        PYCOOR=0.
21844      ELSE
21845        XCOOR=REAL(IXCOOR)
21846        YCOOR=REAL(IYCOOR)
21847        PXCOOR=100.0*(XCOOR/ANUMHP)
21848        PYCOOR=100.0*(YCOOR/ANUMVP)
21849CCCCC   PYCOOR=100.0-PYCOOR
21850      ENDIF
21851C
21852#endif
21853      GOTO9000
21854C
21855C               ******************************************************
21856C               **  STEP 150--                                      **
21857C               **  TREAT THE LATEX (EEPIC)                  DRIVER **
21858C               ******************************************************
21859C
2186015000 CONTINUE
21861      GOTO9000
21862C
21863C               ******************************************************
21864C               **  STEP 160--                                      **
21865C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
21866C               ******************************************************
21867C
2186816000 CONTINUE
21869      GOTO9000
21870C
21871C               ******************************************************
21872C               **  STEP 170--                                      **
21873C               **  TREAT THE CAIRO                          DRIVER **
21874C               ******************************************************
21875C
2187617000 CONTINUE
21877#ifdef HAVE_CAIRO
21878C
21879C     SPECIFY THE SPECIFIC DEVICE AND WHETHER WE HAVE DEVICE 1, 2 OR 3.
21880C
21881      IVAL1=0
21882      IF(IMODEL.EQ.'X11')IVAL1=1
21883      IF(IMODEL.EQ.'POST')IVAL1=2
21884      IF(IMODEL.EQ.'PDF')IVAL1=3
21885      IF(IMODEL.EQ.'SVG')IVAL1=4
21886      IF(IMODEL.EQ.'QUAR')IVAL1=5
21887      IF(IMODEL.EQ.'PNG')IVAL1=6
21888      IF(IMODEL.EQ.'WIND')IVAL1=7
21889      IF(IMODEL.EQ.'EPS')IVAL1=8
21890      IF(IVAL1.EQ.0)THEN
21891        WRITE(ICOUT,999)
21892        CALL DPWRST('XXX','BUG ')
21893        WRITE(ICOUT,17006)IMODEL
2189417006   FORMAT('***** ERROR: MODEL ',A4, ' IS NOT SUPPORTED FOR CAIRO.')
21895        CALL DPWRST('XXX','BUG ')
21896      ENDIF
21897      IVAL2=1
21898      IF(IGUNIT.EQ.IPL1NU)IVAL2=2
21899      IF(IGUNIT.EQ.IPL2NU)IVAL2=3
21900C
21901C     READING SCREEN COORDINATES IS CURRENTLY ONLY SUPPORTED
21902C     FOR SCREEN DEVICES (CURRENLY ONLY X11 IS WORKING).
21903C
21904      IF(IVAL2.GT.1)THEN
21905        GOTO9000
21906      ELSEIF(IVAL1.NE.1)THEN
21907        WRITE(ICOUT,999)
21908        CALL DPWRST('XXX','BUG ')
21909        WRITE(ICOUT,17082)
2191017082   FORMAT('****** ERROR IN CROSS HAIR COMMAND FOR CAIRO DEVICE')
21911        CALL DPWRST('XXX','BUG ')
21912        WRITE(ICOUT,17084)
2191317084   FORMAT('       THE CROSS HAIR COMMAND IS CURRENTLY ONLY ',
21914     1         'SUPPORTED FOR THE X11 DEVICE.')
21915        CALL DPWRST('XXX','BUG ')
21916        GOTO9000
21917      ENDIF
21918C
21919      WRITE(ICOUT,17611)
2192017611 FORMAT(1X,'POSITION THE CURSUR VIA THE MOUSE TO THE DESIRED ')
21921      CALL DPWRST('XXX','BUG ')
21922      WRITE(ICOUT,17612)
2192317612 FORMAT(1X,'LOCATION AND THEN PRESS ANY MOUSE BUTTON')
21924      CALL DPWRST('XXX','BUG ')
21925      CALL CARDLO(IVAL2,IVAL1,IXCOOR,IYCOOR,IXERR)
21926      IF(IXERR.NE.1)THEN
21927        XCOOR=IXCOOR
21928        YCOOR=IYCOOR
21929        PXCOOR=100.0*(XCOOR/ANUMHP)
21930        PYCOOR=100.0*(YCOOR/ANUMVP)
21931        PYCOOR=100.0-PYCOOR
21932      ELSE
21933        WRITE(ICOUT,17621)
2193417621   FORMAT(1X,'***** ERROR TRYING TO READ MOUSE POSITION.')
21935        CALL DPWRST('XXX','BUG ')
21936        PXCOOR=0.
21937        PYCOOR=0.
21938      ENDIF
21939C
21940#endif
21941      GOTO9000
21942C
21943C               ******************************************************
21944C               **  STEP 180--                                      **
21945C               **  TREAT THE WMF                            DRIVER **
21946C               ******************************************************
21947C
2194818000 CONTINUE
21949      GOTO9000
21950C
21951C               ******************************************************
21952C               **  STEP 190--                                      **
21953C               **  TREAT THE D3                             DRIVER **
21954C               ******************************************************
21955C
2195619000 CONTINUE
21957      GOTO9000
21958C
21959C               *****************
21960C               **  STEP 90--  **
21961C               **  EXIT       **
21962C               *****************
21963C
21964 9000 CONTINUE
21965      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RESC')THEN
21966        WRITE(ICOUT,999)
21967        CALL DPWRST('XXX','BUG ')
21968        WRITE(ICOUT,9011)
21969 9011   FORMAT('***** AT THE END       OF GRRESC--')
21970        CALL DPWRST('XXX','BUG ')
21971        WRITE(ICOUT,9015)NCSTR,IXCOOR,IYCOOR,PXCOOR,PYCOOR
21972 9015   FORMAT('NCSTR,IXCOOR,IYCOOR,PXCOOR,PYCOOR = ',3I8,2G15.7)
21973        CALL DPWRST('XXX','BUG ')
21974        IF(NCSTR.GT.0)THEN
21975          DO9025I=1,NCSTR
21976            CALL DPCOAN(ICSTR(I:I),IASCNE)
21977            WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
21978 9026       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
21979            CALL DPWRST('XXX','BUG ')
21980 9025     CONTINUE
21981        ENDIF
21982        WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
21983 9029   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
21984        CALL DPWRST('XXX','BUG ')
21985      ENDIF
21986C
21987      RETURN
21988      END
21989      SUBROUTINE GRRIBE
21990C
21991C     PURPOSE--RING THE BELL OF A SPECIFIC GRAPHICS DEVICE,
21992C
21993C     WRITTEN BY--JAMES J. FILLIBEN
21994C                 STATISTICAL ENGINEERING DIVISION
21995C                 INFORMATION TECHNOLOGY LABORATORY
21996C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
21997C                 GAITHERSBURG, MD 20899-8980
21998C                 PHONE--301-975-2855
21999C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
22000C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
22001C     LANGUAGE--ANSI FORTRAN (1977)
22002C     VERSION NUMBER--83.6
22003C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
22004C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
22005C                                      DRIVER OBSOLETE
22006C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
22007C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
22008C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
22009C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
22010C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
22011C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
22012C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
22013C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
22014C                                      DRIVER OBSOLETE
22015C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
22016C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
22017C                                      OLD CALCOMP STYLE
22018C                                      DRIVER OBSOLETE
22019C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
22020C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
22021C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
22022C                                      USE BILL MITCHELLS OPENGL
22023C                                      BINDING FOR FORTRAN
22024C     UPDATED         --OCTOBER  1996. GKS (ALAN)
22025C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
22026C                                      PLACEHOLDER FOR NOW
22027C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
22028C                                      PLACEHOLDER FOR NOW
22029C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
22030C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
22031C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
22032C     UPDATED         --JUNE     2000. MACINTOSH
22033C                                      PLACEHOLDER FOR NOW
22034C     UPDATED         --JUNE     2000. PC PRINTER
22035C                                      PLACEHOLDER FOR NOW
22036C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
22037C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
22038C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
22039C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
22040C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
22041C
22042C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
22043C
22044#ifdef HAVE_WININTERACTER
22045      USE WINTERACTER
22046#endif
22047#ifdef HAVE_INTERACTER
22048      USE INTERACTER
22049#endif
22050      CHARACTER*130 ICSTR
22051      CHARACTER*4 ISUBN0
22052C
22053C-----COMMON----------------------------------------------------------
22054C
22055      INCLUDE 'DPCOGR.INC'
22056      INCLUDE 'DPCONP.INC'
22057      INCLUDE 'DPCOBE.INC'
22058      INCLUDE 'DPCOP2.INC'
22059C
22060C-----START POINT-----------------------------------------------------
22061C
22062      ISUBN0='RIBE'
22063      IERRG4='NO'
22064C
22065      NCSTR=(-999)
22066C
22067      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RIBE')THEN
22068        WRITE(ICOUT,999)
22069  999   FORMAT(1X)
22070        CALL DPWRST('XXX','BUG ')
22071        WRITE(ICOUT,51)
22072   51   FORMAT('***** AT THE BEGINNING OF GRRIBE--')
22073        CALL DPWRST('XXX','BUG ')
22074        WRITE(ICOUT,53)IMANUF,IMODEL,IBUGG4,IGUNIT
22075   53   FORMAT('IMANUF,IMODEL,IBUGG4,IGUNIT = ',3(A4,2X),I8)
22076        CALL DPWRST('XXX','BUG ')
22077      ENDIF
22078C
22079C               ********************************************
22080C               **  STEP 1--                              **
22081C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
22082C               **  AND THE MODEL                         **
22083C               ********************************************
22084C
22085      IF(IMANUF.EQ.'QWIN')THEN
22086        GOTO4700
22087      ELSEIF(IMANUF.EQ.'POST')THEN
22088        GOTO8600
22089      ELSEIF(IMANUF.EQ.'X11 ')THEN
22090        GOTO9600
22091      ELSEIF(IMANUF.EQ.'AQUA')THEN
22092        GOTO13500
22093      ELSEIF(IMANUF.EQ.'GENE')THEN
22094        IF(IMODEL.EQ.'CODE')GOTO3200
22095        IF(IMODEL.EQ.'CGM')GOTO3300
22096        IF(IMODEL.EQ.'CGMB')GOTO3400
22097        GOTO3100
22098      ELSEIF(IMANUF.EQ.'SVG ')THEN
22099        GOTO16000
22100      ELSEIF(IMANUF.EQ.'GD  ')THEN
22101        GOTO12000
22102      ELSEIF(IMANUF.EQ.'LATE')THEN
22103        GOTO15000
22104      ELSEIF(IMANUF.EQ.'CAIR')THEN
22105        GOTO17000
22106      ELSEIF(IMANUF.EQ.'D3  ')THEN
22107        GOTO19000
22108      ELSEIF(IMANUF.EQ.'WMF ')THEN
22109        GOTO18000
22110      ELSEIF(IMANUF.EQ.'OPGL')THEN
22111        GOTO4800
22112      ELSEIF(IMANUF.EQ.'TEKT')THEN
22113        IF(IMODEL.EQ.'4662')GOTO9000
22114C
22115        IF(IMODEL.EQ.'4020')GOTO1200
22116        IF(IMODEL.EQ.'4022')GOTO1200
22117        IF(IMODEL.EQ.'4025')GOTO1200
22118        IF(IMODEL.EQ.'4027')GOTO1200
22119C
22120        GOTO1100
22121      ELSEIF(IMANUF.EQ.'HP')THEN
22122        IF(IMODEL.EQ.'7221')GOTO2100
22123        IF(IMODEL.EQ.'2622')GOTO2300
22124        IF(IMODEL.EQ.'2623')GOTO2300
22125        IF(IMODEL.EQ.'2627')GOTO2300
22126        IF(IMODEL.EQ.'2647')GOTO2300
22127        GOTO2200
22128      ELSEIF(IMANUF.EQ.'LIBP')THEN
22129        GOTO2600
22130      ELSEIF(IMANUF.EQ.'REGI')THEN
22131        GOTO8100
22132      ELSEIF(IMANUF.EQ.'GKS ')THEN
22133        GOTO11000
22134      ELSEIF(IMANUF.EQ.'LAHE')THEN
22135        IF(IMODEL.EQ.'INTE')GOTO4900
22136        IF(IMODEL.EQ.'WINT')GOTO4950
22137        GOTO4600
22138      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
22139        GOTO13000
22140      ELSEIF(IMANUF.EQ.'QUIC')THEN
22141        GOTO9100
22142      ELSEIF(IMANUF.EQ.'CALC')THEN
22143        GOTO4100
22144      ELSEIF(IMANUF.EQ.'ZETA')THEN
22145        GOTO5100
22146      ELSEIF(IMANUF.EQ.'TURB')THEN
22147        GOTO10000
22148      ELSEIF(IMANUF.EQ.'SUN ')THEN
22149        GOTO6600
22150      ENDIF
22151      GOTO9000
22152C
22153C               ************************************************************
22154C               **  STEP 11--                                             **
22155C               **  TREAT THE TEKTRONIX 400X, 401X, 405X, AND 4114 CASES  **
22156C               **  (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES)      **
22157C               **  TO RING THE BELL,                                     **
22158C               **  WRITE OUT AN ESCAPE BEL                               **
22159C               ************************************************************
22160C
22161 1100 CONTINUE
22162      ICSTR(1:1)=IESCC
22163      ICSTR(2:2)=IBELC
22164      NCSTR=2
22165      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
22166      GOTO9000
22167C
22168C               ******************************************************
22169C               **  STEP 12--                                       **
22170C               **  TREAT THE TEKTRONIX 4020, 4022, AND 4025 CASES  **
22171C               **  (NON-COLOR RASTER DEVICES).                     **
22172C               **  TO RING THE BELL,                               **
22173C               **  USE THE !BEL COMMAND                            **
22174C               **  REFERENCE--4027 OPERATOR'S MANUAL, PAGE B-3.    **
22175C               ******************************************************
22176C
22177 1200 CONTINUE
22178      ICSTR(1:5)='!BEL;'
22179      NCSTR=5
22180      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
22181      GOTO9000
22182C
22183C               ******************************************************
22184C               **  STEP 21--                                       **
22185C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
22186C               **  (MULTI-COLOR PENPLOTTER)                        **
22187C               **  THERE IS NO   RING BELL   INSTRUCTION PER SE.   **
22188C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
22189C               **             OPERATING AND PROGRAMMING MANUAL,    **
22190C               **             PAGE XX.                             **
22191C               ******************************************************
22192C
22193 2100 CONTINUE
22194      GOTO9000
22195C
22196C               ******************************************************
22197C               **  STEP 22--                                       **
22198C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
22199C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
22200C               **  (MULTI-COLOR PENPLOTTERS)                       **
22201C               **  THERE IS NO   RING BELL   INSTRUCTION PER SE.   **
22202C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
22203C               **             OPERATING AND PROGRAMMING MANUAL,    **
22204C               **             PAGE XX, XXX.                        **
22205C               ******************************************************
22206C
22207 2200 CONTINUE
22208      GOTO9000
22209C
22210C               **********************************************************
22211C               **  STEP 23--                                           **
22212C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
22213C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
22214C               **  (MONOCHROME DISPLAY TERMINALS)                      **
22215C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
22216C               **             REFERENCE MANUAL,                        **
22217C               **             PAGE 3-12, XXX.                          **
22218C               **********************************************************
22219C
22220 2300 CONTINUE
22221      ICSTR(1:1)=IBELC
22222      NCSTR=1
22223      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
22224      GOTO9000
22225C
22226C               **********************************************************
22227C               **  STEP 26--                                           **
22228C               **  TREAT THE HEWLETT-PACKARD PCL (LASER JET) CASE      **
22229C               **  REFERENCE--                                         **
22230C               **     LASERJET SERIES II PRINTER, TECHNICAL REFERENCE  **
22231C               **             MANUAL, CHAPTERS 4, 5, 8                 **
22232C               **********************************************************
22233C
22234 2600 CONTINUE
22235      GOTO9000
22236C
22237C               ******************************************************
22238C               **  STEP 31--                                       **
22239C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
22240C               ******************************************************
22241C
22242 3100 CONTINUE
22243      ICSTR(1:9)='RING BELL'
22244      NCSTR=9
22245      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
22246      GOTO9000
22247C
22248C               ***************************************************************
22249C               **  STEP 32--                                                **
22250C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
22251C               ***************************************************************
22252C
22253 3200 CONTINUE
22254      ICSTR(1:4)='RIBE'
22255      NCSTR=4
22256      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
22257      GOTO9000
22258C
22259C               ***************************************************************
22260C               **  STEP 33--                                                **
22261C               **  UNSUPPORTED CGM FEATURE                                  **
22262C               ***************************************************************
22263C
22264 3300 CONTINUE
22265      GOTO9000
22266C
22267C               ***************************************************
22268C               **  STEP 34--                                    **
22269C               **  TREAT THE CGM (BINARY)                 CASE  **
22270C               ***************************************************
22271C
22272 3400 CONTINUE
22273      GOTO9000
22274C
22275C               ******************************************************
22276C               **  STEP 41--                                       **
22277C               **  TREAT THE CALCOMP XXXXXX CASE                   **
22278C               **  TO RING BELL--                                  **
22279C               **  WRITE OUT AN XXXXXXXXXX                         **
22280C               **  (NOT DONE)                                      **
22281C               **  REFERENCE--XX                                   **
22282C               **             XX                                   **
22283C               **             PAGES XX AND XX                      **
22284C               ******************************************************
22285C
22286 4100 CONTINUE
22287      GOTO9000
22288C
22289C               ******************************************************
22290C               **  STEP 46--                                       **
22291C               **  TREAT THE LAHEY   XXXXXX CASE                   **
22292C               **  REFERENCE--Programmer's Reference, Revision C   **
22293C               **             Lahey Computer Systems, January, 1992**
22294C               **             PAGES 51 THRU 65                     **
22295C               ******************************************************
22296C
22297 4600 CONTINUE
22298      GOTO9000
22299C
22300C               ******************************************************
22301C               **  STEP 47--                                       **
22302C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
22303C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
22304C               ******************************************************
22305C
22306 4700 CONTINUE
22307      GOTO9000
22308C
22309C               ******************************************************
22310C               **  STEP 48--                                       **
22311C               **  TREAT THE OPEN-GL DRIVER                        **
22312C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
22313C               ******************************************************
22314C
22315 4800 CONTINUE
22316      GOTO9000
22317C
22318C               ******************************************************
22319C               **  STEP 49--                                       **
22320C               **  TREAT THE LAHEY INTERACTOR CASE                 **
22321C               ******************************************************
22322C
22323 4900 CONTINUE
22324#ifdef HAVE_INTERACTER
22325      CALL IScreenBell(' ')
22326#endif
22327      GOTO9000
22328C
22329C               ******************************************************
22330C               **  STEP 49B-                                       **
22331C               **  TREAT THE LAHEY WINTERACTOR CASE                **
22332C               ******************************************************
22333C
22334 4950 CONTINUE
22335#ifdef HAVE_WININTERACTER
22336      CALL WindowBell(' ')
22337#endif
22338      GOTO9000
22339C
22340C
22341C               ******************************************************
22342C               **  STEP 51--                                       **
22343C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
22344C               **  THERE IS NO   RING BELL   INSTRUCTION PER SE.   **
22345C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
22346C               **             MODELS 3600SX AND 3653SX             **
22347C               **             PAGES B-0 AND B-1                    **
22348C               ******************************************************
22349C
22350 5100 CONTINUE
22351      GOTO9000
22352C
22353C               ******************************************************
22354C               **  STEP 66--                                       **
22355C               **  TREAT THE SUN CASE                              **
22356C               **  WRITTEN BY BILL ANDERSON                        **
22357C               ******************************************************
22358C
22359 6600 CONTINUE
22360      GOTO9000
22361C
22362C               ******************************************************
22363C               **  STEP 81--                                       **
22364C               **  TREAT THE DEC  REGIS CASE                       **
22365C               **  TO RING BELL--                                  **
22366C               **  WRITE OUT AN BEL                                  **
22367C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
22368C               **             PAGES 44 AND 96                      **
22369C               ******************************************************
22370C
22371 8100 CONTINUE
22372      ICSTR(1:1)=IBELC
22373      NCSTR=1
22374      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
22375      GOTO9000
22376C
22377C               ******************************************************
22378C               **  STEP 86                                         **
22379C               **  TREAT THE POSTSCRIPT  CASE                      **
22380C               ******************************************************
22381C
22382 8600 CONTINUE
22383      GOTO9000
22384C
22385C               ******************************************************
22386C               **  STEP 90--                                       **
22387C               **  TREAT THE QUIC       CASE                       **
22388C               **  REFERENCE--QUIC PROGRAMMING MANUAL              **
22389C               ******************************************************
22390C
22391 9100 CONTINUE
22392      GOTO9000
22393C
22394C               ******************************************************
22395C               **  STEP 96--                                       **
22396C               **  TREAT THE X11        CASE                       **
22397C               ******************************************************
22398C
22399 9600 CONTINUE
22400      GOTO9000
22401C
22402C               *************************************************
22403C               **  STEP 100--                                 **
22404C               **  TREAT THE VGA VIA TURBO-C       CASE       **
22405C               *************************************************
22406C
2240710000 CONTINUE
22408CTURB CALL TCRIBE
22409      GOTO9000
22410C
22411C               ******************************************************
22412C               **  STEP 110--                                      **
22413C               **  TREAT THE GKS                DRIVER             **
22414C               ******************************************************
22415C
2241611000 CONTINUE
22417      GOTO9000
22418C
22419C               ******************************************************
22420C               **  STEP 120--                                      **
22421C               **  TREAT THE GD                     DRIVER         **
22422C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
22423C               **  1) JPEG                                         **
22424C               **  2) PNG                                          **
22425C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
22426C               ******************************************************
22427C
2242812000 CONTINUE
22429      GOTO9000
22430C
22431C               ******************************************************
22432C               **  STEP 130--                                      **
22433C               **  TREAT THE ABSOFT                 DRIVER         **
22434C               ******************************************************
22435C
2243613000 CONTINUE
22437      GOTO9000
22438C
22439C               ******************************************************
22440C               **  STEP 135--                                      **
22441C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
22442C               ******************************************************
22443C
2244413500 CONTINUE
22445      GOTO9000
22446C
22447C               ******************************************************
22448C               **  STEP 150--                                      **
22449C               **  TREAT THE LATEX (EEPIC)                  DRIVER **
22450C               ******************************************************
22451C
2245215000 CONTINUE
22453      GOTO9000
22454C
22455C               ******************************************************
22456C               **  STEP 160--                                      **
22457C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
22458C               ******************************************************
22459C
2246016000 CONTINUE
22461      GOTO9000
22462C
22463C               ******************************************************
22464C               **  STEP 170--                                      **
22465C               **  TREAT THE CAIRO                          DRIVER **
22466C               ******************************************************
22467C
2246817000 CONTINUE
22469      GOTO9000
22470C
22471C               ******************************************************
22472C               **  STEP 180--                                      **
22473C               **  TREAT THE WMF                            DRIVER **
22474C               ******************************************************
22475C
2247618000 CONTINUE
22477      GOTO9000
22478C
22479C               ******************************************************
22480C               **  STEP 190--                                      **
22481C               **  TREAT THE D3                             DRIVER **
22482C               ******************************************************
22483C
2248419000 CONTINUE
22485      GOTO9000
22486C
22487C               *****************
22488C               **  STEP 90--  **
22489C               **  EXIT       **
22490C               *****************
22491C
22492 9000 CONTINUE
22493      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'RIBE')THEN
22494        WRITE(ICOUT,999)
22495        CALL DPWRST('XXX','BUG ')
22496        WRITE(ICOUT,9011)
22497 9011   FORMAT('***** AT THE END       OF GRRIBE--')
22498        CALL DPWRST('XXX','BUG ')
22499        WRITE(ICOUT,9012)IESCC,IBELC,NCSTR,IERG4
22500 9012   FORMAT('IESCC,IBELC,IERRG4 = ',2(A1,2X),I8,2X,A4)
22501        CALL DPWRST('XXX','BUG ')
22502        IF(NCSTR.GT.0)THEN
22503          DO9025I=1,NCSTR
22504            CALL DPCOAN(ICSTR(I:I),IASCNE)
22505            WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
22506 9026       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
22507            CALL DPWRST('XXX','BUG ')
22508 9025     CONTINUE
22509        ENDIF
22510      ENDIF
22511C
22512      RETURN
22513      END
22514      SUBROUTINE GRSAGR(ICODE,ISTRI2,NCSTR2,CTEMP,NCTEMP)
22515C
22516C     PURPOSE--IMPLEMENT THE SAVE PLOT, REPEAT PLT, CYCLE PLOT
22517C              COMMANDS ON A SPECIFIC GRAPHICS DEVICE
22518C
22519C     WRITTEN BY--JAMES J. FILLIBEN
22520C                 STATISTICAL ENGINEERING DIVISION
22521C                 INFORMATION TECHNOLOGY LABORATORY
22522C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
22523C                 GAITHERSBURG, MD 20899-8980
22524C                 PHONE--301-975-2899
22525C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
22526C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
22527C     LANGUAGE--ANSI FORTRAN (1977)
22528C     VERSION NUMBER--97.8
22529C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--AUGUST    1997.
22530C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
22531C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
22532C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
22533C     UPDATED         --JUNE     2000. MACINTOSH
22534C                                      PLACEHOLDER FOR NOW
22535C     UPDATED         --JUNE     2000. PC PRINTER
22536C                                      PLACEHOLDER FOR NOW
22537C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
22538C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
22539C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
22540C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
22541C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
22542C
22543C-----NON-COMMON VARIABLES (GRAPHICS)---------------------------------
22544C
22545#ifdef HAVE_WININTERACTER
22546      USE WINTERACTER
22547#endif
22548#ifdef HAVE_INTERACTER
22549      USE INTERACTER
22550#endif
22551#ifdef HAVE_QWIN
22552CQWIN USE DFLIB
22553      USE IFQWIN
22554      LOGICAL MODESTATUS
22555      TYPE (WINDOWCONFIG)   DPSCREEN
22556      TYPE (WINDOWCONFIG)   DPSCREEN2
22557      TYPE (QWINFO)   WINFO
22558      TYPE (QWINFO)   WINFO2
22559      TYPE (FONTINFO) MSFONT
22560      CHARACTER*4 QWSCRN
22561      COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
22562#endif
22563C
22564      LOGICAL IMSFLG
22565      CHARACTER*4 ICODE
22566      CHARACTER*256 ISTRI2
22567      CHARACTER*128 CTEMP
22568C
22569#ifdef HAVE_X11
22570      CHARACTER*1 IA
22571      CHARACTER*8 CJUNK
22572      DIMENSION IADE(128)
22573      DIMENSION IWIND(8)
22574      DIMENSION IADE2(128)
22575#endif
22576#ifdef HAVE_OPEN_GL
22577      CHARACTER*1 IA2
22578      CHARACTER*8 CJUNK2
22579      DIMENSION IADEZ(128)
22580      DIMENSION IWIND2(8)
22581      DIMENSION IADE22(128)
22582#endif
22583C
22584      CHARACTER*4 IMANUF
22585      CHARACTER*4 IMODEL
22586      CHARACTER*4 ISUBN0
22587      CHARACTER*4 IERROR
22588C
22589C-----COMMON----------------------------------------------------------
22590C
22591      INCLUDE 'DPCOPA.INC'
22592      INCLUDE 'DPCOPM.INC'
22593      INCLUDE 'DPCOPC.INC'
22594      INCLUDE 'DPCOBE.INC'
22595      INCLUDE 'DPCODV.INC'
22596      INCLUDE 'DPCOP2.INC'
22597C
22598      DATA IMSFLG/.TRUE./
22599C
22600C-----START POINT-----------------------------------------------------
22601C
22602      ISUBN0='SAGR'
22603      IERRG4='NO'
22604      IERROR='NO'
22605      CTEMP=' '
22606      NCTEMP=1
22607      IMANUF=IDMANU(1)
22608      IMODEL=IDMODE(1)
22609C
22610      NCSTR=(-999)
22611C
22612      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SAGR')THEN
22613        WRITE(ICOUT,999)
22614  999   FORMAT(1X)
22615        CALL DPWRST('XXX','BUG ')
22616        WRITE(ICOUT,51)
22617   51   FORMAT('***** AT THE BEGINNING OF GRSAGR--')
22618        CALL DPWRST('XXX','BUG ')
22619        WRITE(ICOUT,52)IMANUF,IMODEL,ICODE
22620   52   FORMAT('IMANUF,IMODEL,ICODE = ',2(A4,2X),I8)
22621        CALL DPWRST('XXX','BUG ')
22622        WRITE(ICOUT,55)NCSTR2,ISTRI2(1:MIN(80,NCSTR2))
22623   55   FORMAT('NCSTR2,ISTRI2(1:MIN(80,NCSTR2)) = ',I5,2X,80A1)
22624        CALL DPWRST('XXX','BUG ')
22625      ENDIF
22626C
22627C               ********************************************
22628C               **  STEP 1--                              **
22629C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
22630C               **  AND THE MODEL                         **
22631C               ********************************************
22632C
22633      IF(IMANUF.EQ.'QWIN')THEN
22634        GOTO4700
22635      ELSEIF(IMANUF.EQ.'POST')THEN
22636        GOTO8600
22637      ELSEIF(IMANUF.EQ.'X11 ')THEN
22638        GOTO9600
22639      ELSEIF(IMANUF.EQ.'AQUA')THEN
22640        GOTO13500
22641      ELSEIF(IMANUF.EQ.'GENE')THEN
22642        GOTO3100
22643      ELSEIF(IMANUF.EQ.'SVG ')THEN
22644        GOTO16000
22645      ELSEIF(IMANUF.EQ.'GD  ')THEN
22646        GOTO12000
22647      ELSEIF(IMANUF.EQ.'LATE')THEN
22648        GOTO15000
22649      ELSEIF(IMANUF.EQ.'CAIR')THEN
22650        GOTO17000
22651      ELSEIF(IMANUF.EQ.'D3  ')THEN
22652        GOTO19000
22653      ELSEIF(IMANUF.EQ.'WMF ')THEN
22654        GOTO18000
22655      ELSEIF(IMANUF.EQ.'OPGL')THEN
22656        GOTO4800
22657      ELSEIF(IMANUF.EQ.'TEKT')THEN
22658        GOTO1100
22659      ELSEIF(IMANUF.EQ.'HP')THEN
22660        GOTO2100
22661      ELSEIF(IMANUF.EQ.'LIBP')THEN
22662        GOTO2600
22663      ELSEIF(IMANUF.EQ.'REGI')THEN
22664        GOTO8100
22665      ELSEIF(IMANUF.EQ.'GKS ')THEN
22666        GOTO11000
22667      ELSEIF(IMANUF.EQ.'LAHE')THEN
22668        IF(IMODEL.EQ.'INTE')GOTO4900
22669        IF(IMODEL.EQ.'WINT')GOTO4950
22670        GOTO4600
22671      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
22672        GOTO13000
22673      ELSEIF(IMANUF.EQ.'QUIC')THEN
22674        GOTO9100
22675      ELSEIF(IMANUF.EQ.'CALC')THEN
22676        GOTO4100
22677      ELSEIF(IMANUF.EQ.'ZETA')THEN
22678        GOTO5100
22679      ELSEIF(IMANUF.EQ.'TURB')THEN
22680        GOTO10000
22681      ELSEIF(IMANUF.EQ.'SUN ')THEN
22682        GOTO6600
22683      ENDIF
22684      GOTO9000
22685C
22686C               ******************************************************
22687C               **  STEP 11--                                       **
22688C               **  TREAT THE TEKTRONIX CASE                        **
22689C               **  REFERENCE--XXX                                  **
22690C               ******************************************************
22691C
22692 1100 CONTINUE
22693      WRITE(ICOUT,1110)
22694 1110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
22695     1'GRAPH COMMANDS NOT SUPPORTED FOR TEKTRONIX DEVICES.')
22696      CALL DPWRST('XXXX','BUG')
22697      GOTO9000
22698C
22699C               ******************************************************
22700C               **  STEP 21--                                       **
22701C               **  TREAT THE HEWLETT-PACKARD      CASE             **
22702C               ******************************************************
22703C
22704 2100 CONTINUE
22705      WRITE(ICOUT,2110)
22706 2110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
22707     1'GRAPH COMMANDS NOT SUPPORTED FOR HP DEVICES.')
22708      CALL DPWRST('XXXX','BUG')
22709      GOTO9000
22710C
22711C               ******************************************************
22712C               **  STEP 26--                                       **
22713C               **  TREAT THE UNIX LIBPLOT         CASE             **
22714C               ******************************************************
22715C
22716 2600 CONTINUE
22717      WRITE(ICOUT,2610)
22718 2610 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
22719     1'GRAPH COMMANDS NOT SUPPORTED FOR LIBPLOT DEVICES.')
22720      CALL DPWRST('XXXX','BUG')
22721      GOTO9000
22722C
22723C               ******************************************************
22724C               **  STEP 31--                                       **
22725C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
22726C               ******************************************************
22727C
22728 3100 CONTINUE
22729      WRITE(ICOUT,3110)
22730 3110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
22731     1       'GRAPH COMMANDS NOT SUPPORTED FOR GENERAL DEVICES.')
22732      CALL DPWRST('XXXX','BUG')
22733      GOTO9000
22734C
22735C               ******************************************************
22736C               **  STEP 41--                                       **
22737C               **  TREAT THE CALCOMP XXXXXX CASE                   **
22738C               **  (NOT DONE)                                      **
22739C               **  REFERENCE--XX                                   **
22740C               **             XX                                   **
22741C               **             PAGES XX AND XX                      **
22742C               ******************************************************
22743C
22744 4100 CONTINUE
22745      WRITE(ICOUT,4110)
22746 4110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
22747     1'GRAPH COMMANDS NOT SUPPORTED FOR CALCOMP DEVICES.')
22748      CALL DPWRST('XXXX','BUG')
22749      GOTO9000
22750C
22751C               ******************************************************
22752C               **  STEP 46--                                       **
22753C               **  TREAT THE LAHEY   XXXXXX CASE                   **
22754C               **  REFERENCE--Programmer's Reference, Revision C   **
22755C               **             Lahey Computer Systems, January, 1992**
22756C               **             PAGES 51 THRU 65                     **
22757C               ******************************************************
22758C
22759 4600 CONTINUE
22760      WRITE(ICOUT,4610)
22761 4610 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
22762     1'GRAPH COMMANDS NOT SUPPORTED FOR LAHEY DEVICE.')
22763      CALL DPWRST('XXXX','BUG')
22764      GOTO9000
22765C
22766C               ******************************************************
22767C               **  STEP 47--                                       **
22768C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
22769C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
22770C               ******************************************************
22771C
22772 4700 CONTINUE
22773#ifdef HAVE_QWIN
22774      IF(ICODE.EQ.'SAVE')THEN
22775        IRESLT=FOCUSQQ(99)
22776        IRESLT=SETFONT('fh16w8b')
22777        MODESTATUS=GETFONTINFO(MSFONT)
22778        ICHRHT=MSFONT.PIXHEIGHT
22779        ICHRWD=MSFONT.PIXWIDTH
22780        IF(ICHRWD.EQ.0)ICHRWD=MSFONT.AVGWIDTH
22781        IF(ICHRWD.EQ.0)ICHRWD=ICHRHT/2
22782        IRESLT=GETWSIZEQQ(99,QWIN$SIZECURR,WINFO)
22783C
22784        NUMHPP=WINFO.W*ICHRWD
22785        IF(NUMHPP.LE.100)NUMHPP=100
22786        NUMVPP=WINFO.H*ICHRHT
22787        IF(NUMVPP.LE.100)NUMVPP=100
22788        ANUMHP=REAL(NUMHPP)
22789        ANUMVP=REAL(NUMVPP)
22790        IRESLT=SAVEIMAGE(ISTRI2,0,0,NUMHPP-1, NUMVPP-1)
22791      ELSEIF(ICODE.EQ.'CYCL')THEN
22792 4799   CONTINUE
22793        IERR=0
22794        IRESLT=FOCUSQQ(98)
22795        MOUSEEVENT = MOUSE$RBUTTONDOWN .OR. MOUSE$LBUTTONDOWN
22796        IRESLT = WAITONMOUSEEVENT(MOUSEEVENT, KEYSTATE, IX, IY)
22797        IF((MOUSE$KS_SHIFT.AND.KEYSTATE).EQ.MOUSE$KS_SHIFT)THEN
22798          GOTO9000
22799        ELSEIF((MOUSE$KS_CONTROL.AND.KEYSTATE).EQ.MOUSE$KS_CONTROL)THEN
22800          GOTO9000
22801        ELSEIF(IRESLT.EQ.MOUSE$KS_LBUTTON)THEN
22802          ICURPM=ICURPM-1
22803          IF(ICURPM.LT.1)ICURPM=1
22804        ELSEIF(IRESLT.EQ.MOUSE$KS_RBUTTON)THEN
22805          ICURPM=ICURPM+1
22806          IF(ICURPM.GT.NUMPXM)ICURPM=NUMPXM
22807        ELSEIF(IRESLT.EQ.MOUSE$BADEVENT)THEN
22808          GOTO9000
22809        ELSE
22810          GOTO9000
22811        ENDIF
22812C
22813        NCSTR2=1
22814        DO4705I=128,1,-1
22815          NCSTR2=I
22816          IF(IPXMFN(ICURPM)(I:I).NE.' ')GOTO4709
22817 4705   CONTINUE
22818 4709   CONTINUE
22819        CTEMP=' '
22820        IF(ICURPM.LE.9)THEN
22821          CTEMP(1:4)='  - '
22822          WRITE(CTEMP(1:1),'(I1)')ICURPM
22823          NCTEMP=4
22824        ELSEIF(ICURPM.LE.99)THEN
22825          CTEMP(1:5)='   - '
22826          WRITE(CTEMP(1:2),'(I2)')ICURPM
22827          NCTEMP=5
22828        ELSEIF(ICURPM.LE.999)THEN
22829          CTEMP(1:6)='    - '
22830          WRITE(CTEMP(1:3),'(I3)')ICURPM
22831          NCTEMP=6
22832        ENDIF
22833        NCHRS=80-NCTEMP
22834        NCTEMP=NCTEMP+1
22835        CTEMP(NCTEMP:80)=IPXMFN(ICURPM)(1:NCHRS)
22836        IF(IMSFLG)THEN
22837          DPSCREEN2=DPSCREEN
22838          WINFO2=WINFO
22839          WINFO2.Y=0
22840          DPSCREEN2.TITLE=CTEMP
22841          OPEN(UNIT=98,FILE='USER',TITLE=CTEMP,
22842     1       IOFOCUS=.TRUE.)
22843C
22844          MODESTATUS=SETWINDOWCONFIG(DPSCREEN2)
22845          IF(.NOT. MODESTATUS) MODESTATUS=SETWINDOWCONFIG(DPSCREEN2)
22846          ISTATUS=DISPLAYCURSOR($GCURSORON)
22847          MODESTATUS=GETWINDOWCONFIG(DPSCREEN2)
22848          IRESLT=GETWSIZEQQ(99,QWIN$SIZECURR,WINFO2)
22849C
22850          IRESLT=SETWSIZEQQ(98,WINFO2)
22851          IRESLT=GETWSIZEQQ(98,QWIN$SIZECURR,WINFO2)
22852C
22853          IRESLT=FOCUSQQ(98)
22854        ENDIF
22855        IRESLT=LOADIMAGE(IPXMFN(ICURPM),0,0)
22856        IMSFLG=.FALSE.
22857C
22858        GOTO4799
22859      ELSEIF(ICODE.EQ.'REST')THEN
22860        IF(IMSFLG)THEN
22861          DPSCREEN2=DPSCREEN
22862          WINFO2=WINFO
22863          WINFO2.Y=0
22864          DPSCREEN2.TITLE=CTEMP
22865          OPEN(UNIT=98,FILE='USER',TITLE=CTEMP,
22866     1       IOFOCUS=.TRUE.)
22867C
22868          MODESTATUS=SETWINDOWCONFIG(DPSCREEN2)
22869          IF(.NOT. MODESTATUS) MODESTATUS=SETWINDOWCONFIG(DPSCREEN2)
22870          ISTATUS=DISPLAYCURSOR($GCURSORON)
22871          MODESTATUS=GETWINDOWCONFIG(DPSCREEN2)
22872          IRESLT=GETWSIZEQQ(99,QWIN$SIZECURR,WINFO2)
22873C
22874          IRESLT=SETWSIZEQQ(98,WINFO2)
22875          IRESLT=GETWSIZEQQ(98,QWIN$SIZECURR,WINFO2)
22876C
22877          IRESLT=FOCUSQQ(98)
22878        ENDIF
22879        IRESLT=LOADIMAGE(ISTRI2,0,0)
22880CCCCC   IMSFLG=.FALSE.
22881      ENDIF
22882C
22883 4790 CONTINUE
22884      IRESLT=FOCUSQQ(IPR)
22885      IRESLT=DISPLAYCURSOR($GCURSORON)
22886#endif
22887      GOTO9000
22888C
22889C               ******************************************************
22890C               **  STEP 48--                                       **
22891C               **  TREAT THE OPEN-GL DRIVER                        **
22892C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
22893C               ******************************************************
22894C
22895 4800 CONTINUE
22896#ifdef HAVE_OPEN_GL
22897      IF(ICODE.EQ.'SAVE')THEN
22898        DO4820I=1,NCSTR2
22899          CALL DPCOAN(ISTRI2(I:I),IJUNK)
22900          IADEZ(I)=IJUNK
22901 4820   CONTINUE
22902        IADEZ(NCSTR2+1)=0
22903C
22904        IERR=0
22905        CALL GLSAVG(IADEZ,IERR)
22906        IF(IERR.EQ.1)THEN
22907          WRITE(ICOUT,999)
22908          CALL DPWRST('XXX','BUG ')
22909          WRITE(ICOUT,4851)
22910          CALL DPWRST('XXX','BUG ')
22911          IERROR='YES'
22912          GOTO9000
22913 4851 FORMAT('***** ERROR IN DPSAPL--WRITING BIT MAP UNSUCCESSFUL.')
22914          ELSEIF(IERR.EQ.2)THEN
22915            WRITE(ICOUT,999)
22916            CALL DPWRST('XXX','BUG ')
22917            WRITE(ICOUT,4861)
22918            CALL DPWRST('XXX','BUG ')
22919            IERROR='YES'
22920            GOTO9000
22921 4861 FORMAT('***** ERROR IN DPSAPL--NO CURRENT PIXMAP TO SAVE.')
22922        ELSEIF(IERR.EQ.3)THEN
22923          WRITE(ICOUT,999)
22924          CALL DPWRST('XXX','BUG ')
22925          WRITE(ICOUT,4871)
22926          CALL DPWRST('XXX','BUG ')
22927          IERROR='YES'
22928          GOTO9000
22929 4871 FORMAT('***** ERROR IN DPSAPL--OPEN-GL HAS NOT BEEN OPENED.')
22930        ELSEIF(IERR.EQ.4)THEN
22931          WRITE(ICOUT,999)
22932          CALL DPWRST('XXX','BUG ')
22933          WRITE(ICOUT,4881)
22934          CALL DPWRST('XXX','BUG ')
22935          IERROR='YES'
22936          GOTO9000
22937 4881 FORMAT('***** ERROR IN DPSAPL--OPENGL NOT INSTALLED ON THIS ',
22938     1'IMPLEMENTATION.')
22939        ELSE
22940          WRITE(ICOUT,999)
22941          CALL DPWRST('XXX','BUG ')
22942          WRITE(ICOUT,4891)
22943          CALL DPWRST('XXX','BUG ')
22944          WRITE(ICOUT,4892)ISTRI2(1:NCSTR2)
22945          CALL DPWRST('XXX','BUG ')
22946          IERROR='YES'
22947          GOTO9000
22948        ENDIF
22949 4891 FORMAT('***** CURRENT PIXMAP SUCCESSFULLY SAVED TO FILE ')
22950 4892 FORMAT('      ',A128)
22951C
22952      ELSEIF(ICODE.EQ.'REST')THEN
22953        DO19729I=1,8
22954          IWIND2(I)=-1
2295519729   CONTINUE
22956        ICOUNT=0
22957        IF(IX11W2.EQ.'        ')GOTO19739
22958        CJUNK2(1:8)=IX11W2(1:8)
22959        ICOUNT=0
22960        DO19730I=8,1,-1
22961          IA2=CJUNK2(I:I)
22962          IF(IA2.EQ.' ')GOTO19730
22963          ICOUNT=ICOUNT+1
22964          CALL DPCOAN(IA2,IVALUE)
22965          IF(IVALUE.GE.48.AND.IVALUE.LE.57)THEN
22966            IWIND2(ICOUNT)=IVALUE-48
22967          ELSEIF(IVALUE.GE.65.AND.IVALUE.LE.70)THEN
22968            IWIND2(ICOUNT)=IVALUE-55
22969          ELSEIF(IVALUE.GE.197.AND.IVALUE.LE.102)THEN
22970            IWIND2(ICOUNT)=IVALUE-87
22971          ELSE
22972            ICOUNT=1
22973            WRITE(ICOUT,19733)
22974            GOTO19739
22975          ENDIF
2297619730   CONTINUE
2297719733 FORMAT('***** WARNING--INVALID WINDOW ID FROM FRONT-END.  ',
22978     1'A SEPARATE GRAPHICS WINDOW WILL BE OPENED.')
2297919739   CONTINUE
22980        DO19715I=1,NCTEMP
22981          CALL DPCOAN(CTEMP(I:I),IADE22(I))
2298219715   CONTINUE
22983        DO19720I=1,NCSTR2
22984          CALL DPCOAN(ISTRI2(I:I),IADEZ(I))
22985          CALL DPCOAN(ISTRI2(I:I),IADE22(I+NCTEMP))
2298619720   CONTINUE
22987        IADEZ(NCSTR2+1)=0
22988        IADE22(NCSTR2+NCTEMP+1)=0
22989C
22990        IERR=0
22991        CALL GLRESG(IADEZ,IADE22,IWIND2,ICOUNT,IERR)
22992        IF(IERR.EQ.1)THEN
22993          WRITE(ICOUT,999)
22994          CALL DPWRST('XXX','BUG ')
22995          WRITE(ICOUT,19751)
22996          CALL DPWRST('XXX','BUG ')
22997          IERROR='YES'
22998          GOTO9000
2299919751 FORMAT('***** ERROR IN DPREGR--READING BIT MAP UNSUCCESSFUL.')
23000        ELSEIF(IERR.EQ.2)THEN
23001          WRITE(ICOUT,999)
23002          CALL DPWRST('XXX','BUG ')
23003          WRITE(ICOUT,19761)
23004          CALL DPWRST('XXX','BUG ')
23005          IERROR='YES'
23006          GOTO9000
2300719761 FORMAT('***** ERROR IN DPREGR--NO CURRENT PIXMAP TO SAVE.')
23008        ELSEIF(IERR.EQ.3)THEN
23009          WRITE(ICOUT,999)
23010          CALL DPWRST('XXX','BUG ')
23011          WRITE(ICOUT,19771)
23012          CALL DPWRST('XXX','BUG ')
23013          IERROR='YES'
23014          GOTO9000
2301519771 FORMAT('***** ERROR IN DPREGR--OPEN-GL HAS NOT BEEN OPENED.')
23016        ELSEIF(IERR.EQ.4)THEN
23017          WRITE(ICOUT,999)
23018          CALL DPWRST('XXX','BUG ')
23019          WRITE(ICOUT,19781)
23020          CALL DPWRST('XXX','BUG ')
23021          IERROR='YES'
23022          GOTO9000
2302319781 FORMAT('***** ERROR IN DPREGR--OPEN-GL NOT INSTALLED ON THIS ',
23024     1'IMPLEMENTATION.')
23025        ELSEIF(IERR.EQ.5)THEN
23026          WRITE(ICOUT,999)
23027          CALL DPWRST('XXX','BUG ')
23028          WRITE(ICOUT,19786)
23029          CALL DPWRST('XXX','BUG ')
23030          IERROR='YES'
23031          GOTO9000
2303219786 FORMAT('***** ERROR IN DPREGR--UNABLE TO OPEN NEW OPEN-GL ',
23033     1       'WINDOW ')
23034        ELSE
23035          WRITE(ICOUT,999)
23036          CALL DPWRST('XXX','BUG ')
23037          WRITE(ICOUT,19791)
23038          CALL DPWRST('XXX','BUG ')
23039          WRITE(ICOUT,19792)ISTRI2(1:NCSTR2)
23040          CALL DPWRST('XXX','BUG ')
23041          IERROR='YES'
23042          GOTO9000
2304319791 FORMAT('***** CURRENT PIXMAP SUCCESSFULLY COPIED FROM FILE ')
2304419792 FORMAT('      ',A128)
23045        ENDIF
23046C
23047      ELSEIF(ICODE.EQ.'CYCL')THEN
2304814800   CONTINUE
23049        IERR=0
23050        CALL GLCYCL(IERR,IBUTTN)
23051        IF(IERR.EQ.4)THEN
23052          WRITE(ICOUT,999)
23053          CALL DPWRST('XXX','BUG ')
23054          WRITE(ICOUT,14810)
23055          CALL DPWRST('XXX','BUG ')
23056          IERROR='YES'
23057          GOTO9000
23058        ELSEIF(IERR.NE.0)THEN
23059          WRITE(ICOUT,999)
23060          CALL DPWRST('XXX','BUG ')
23061          WRITE(ICOUT,14810)
23062          CALL DPWRST('XXX','BUG ')
23063          IERROR='YES'
23064          GOTO9000
23065        ENDIF
2306614810 FORMAT('***** ERROR FROM DPCYGR: OPEN-GL NOT ACTIVE ON THIS ',
23067     1'IMPLEMENTATION.')
2306814811 FORMAT('***** ERROR FROM DPCYGR: ERROR TRYING TO REDRAW PIXMAP.')
23069        IF(IBUTTN.EQ.1)THEN
23070          ICURPM=ICURPM-1
23071          IF(ICURPM.LT.1)ICURPM=1
23072        ELSEIF(IBUTTN.EQ.3)THEN
23073          ICURPM=ICURPM+1
23074          IF(ICURPM.GT.NUMPXM)ICURPM=NUMPXM
23075        ELSE
23076          GOTO9000
23077        ENDIF
23078C
23079        NCSTR2=1
23080        DO24805I=128,1,-1
23081          NCSTR2=I
23082          IF(IPXMFN(ICURPM)(I:I).NE.' ')GOTO24809
2308324805   CONTINUE
2308424809   CONTINUE
23085        CTEMP=' '
23086        IF(ICURPM.LE.9)THEN
23087          CTEMP(1:4)='  - '
23088          WRITE(CTEMP(1:1),'(I1)')ICURPM
23089          NCTEMP=4
23090        ELSEIF(ICURPM.LE.248)THEN
23091          CTEMP(1:5)='   - '
23092          WRITE(CTEMP(1:2),'(I2)')ICURPM
23093          NCTEMP=5
23094        ELSEIF(ICURPM.LE.2489)THEN
23095          CTEMP(1:6)='    - '
23096          WRITE(CTEMP(1:3),'(I3)')ICURPM
23097          NCTEMP=6
23098        ENDIF
23099        DO24815I=1,NCTEMP
23100          CALL DPCOAN(CTEMP(I:I),IADE22(I))
2310124815 CONTINUE
23102        DO24820I=1,NCSTR2
23103          CALL DPCOAN(IPXMFN(ICURPM)(I:I),IADEZ(I))
23104          CALL DPCOAN(IPXMFN(ICURPM)(I:I),IADE22(I+NCTEMP))
2310524820 CONTINUE
23106        IADEZ(NCSTR2+1)=0
23107        IADE22(NCSTR2+NCTEMP+1)=0
23108        IERR=0
23109        DO24829I=1,8
23110          IWIND2(I)=-1
2311124829   CONTINUE
23112        ICOUNT=0
23113        IF(IX11W2.EQ.'        ')GOTO24839
23114        CJUNK2(1:8)=IX11W2(1:8)
23115        ICOUNT=0
23116        DO24830I=8,1,-1
23117          IA2=CJUNK2(I:I)
23118          IF(IA2.EQ.' ')GOTO24830
23119          ICOUNT=ICOUNT+1
23120          CALL DPCOAN(IA2,IVALUE)
23121          IF(IVALUE.GE.48.AND.IVALUE.LE.57)THEN
23122            IWIND2(ICOUNT)=IVALUE-48
23123          ELSEIF(IVALUE.GE.65.AND.IVALUE.LE.70)THEN
23124            IWIND2(ICOUNT)=IVALUE-55
23125          ELSEIF(IVALUE.GE.248.AND.IVALUE.LE.102)THEN
23126            IWIND2(ICOUNT)=IVALUE-87
23127          ELSE
23128            ICOUNT=1
23129            WRITE(ICOUT,24833)
23130            GOTO24839
23131          ENDIF
2313224830   CONTINUE
2313324833 FORMAT('***** WARNING--INVALID WINDOW ID FROM FRONT-END.  ',
23134     1'A SEPARATE GRAPHICS WINDOW WILL BE OPENED.')
2313524839   CONTINUE
23136        CALL GLRESG(IADEZ,IADE22,IWIND2,ICOUNT,IERR)
23137        IF(IERR.NE.0)THEN
23138          WRITE(ICOUT,999)
23139          CALL DPWRST('XXX','BUG ')
23140          WRITE(ICOUT,14810)
23141          CALL DPWRST('XXX','BUG ')
23142          IERROR='YES'
23143          GOTO9000
23144        ENDIF
23145C
23146        GOTO14800
23147      ENDIF
23148C
23149#endif
23150      GOTO9000
23151C
23152C               ******************************************************
23153C               **  STEP 49--                                       **
23154C               **  TREAT THE LAHEY INTERACTOR CASE                 **
23155C               ******************************************************
23156C
23157 4900 CONTINUE
23158      WRITE(ICOUT,4910)
23159 4910 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
23160     1'GRAPH COMMANDS NOT SUPPORTED FOR LAHEY INTERACTOR DEVICE.')
23161      CALL DPWRST('XXXX','BUG')
23162      GOTO9000
23163C
23164C               ******************************************************
23165C               **  STEP 49B-                                       **
23166C               **  TREAT THE LAHEY WINTERACTOR CASE                **
23167C               ******************************************************
23168C
23169 4950 CONTINUE
23170      WRITE(ICOUT,4960)
23171 4960 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
23172     1'GRAPH COMMANDS NOT SUPPORTED FOR LAHEY WINTERACTOR DEVICE.')
23173      CALL DPWRST('XXXX','BUG')
23174      GOTO9000
23175C
23176C
23177C               ******************************************************
23178C               **  STEP 51--                                       **
23179C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
23180C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
23181C               **             MODELS 3600SX AND 3653SX             **
23182C               **             PAGES B-0 AND B-1                    **
23183C               ******************************************************
23184C
23185 5100 CONTINUE
23186      WRITE(ICOUT,5110)
23187 5110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
23188     1'GRAPH COMMANDS NOT SUPPORTED FOR ZETA DEVICE.')
23189      CALL DPWRST('XXXX','BUG')
23190      GOTO9000
23191C
23192C               ******************************************************
23193C               **  STEP 66--                                       **
23194C               **  TREAT THE SUN       CASE                        **
23195C               **  REFERENCE--XXX                                  **
23196C               ******************************************************
23197C
23198 6600 CONTINUE
23199      WRITE(ICOUT,6610)
23200 6610 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
23201     1'GRAPH COMMANDS NOT SUPPORTED FOR SUN DEVICE.')
23202      CALL DPWRST('XXXX','BUG')
23203      GOTO9000
23204C
23205C
23206C               ******************************************************
23207C               **  STEP 81--                                       **
23208C               **  TREAT THE REGIS     CASE                        **
23209C               **  REFERENCE--XXX                                  **
23210C               ******************************************************
23211C
23212 8100 CONTINUE
23213      WRITE(ICOUT,8110)
23214 8110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
23215     1'GRAPH COMMANDS NOT SUPPORTED FOR REGIS DEVICE.')
23216      CALL DPWRST('XXXX','BUG')
23217      GOTO9000
23218C
23219C
23220C               ******************************************************
23221C               **  STEP 86--                                       **
23222C               **  TREAT THE POSTSCRIPT CASE                       **
23223C               **  REFERENCE--XXX                                  **
23224C               ******************************************************
23225C
23226 8600 CONTINUE
23227      WRITE(ICOUT,8610)
23228 8610 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
23229     1'GRAPH COMMANDS NOT SUPPORTED FOR POSTSCRIPT DEVICE.')
23230      CALL DPWRST('XXXX','BUG')
23231      GOTO9000
23232C
23233C
23234C               ******************************************************
23235C               **  STEP 91--                                       **
23236C               **  TREAT THE QUIC      CASE                        **
23237C               **  REFERENCE--XXX                                  **
23238C               ******************************************************
23239C
23240 9100 CONTINUE
23241      WRITE(ICOUT,9110)
23242 9110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
23243     1'GRAPH COMMANDS NOT SUPPORTED FOR QUIC DEVICE.')
23244      CALL DPWRST('XXXX','BUG')
23245      GOTO9000
23246C
23247C
23248C               ******************************************************
23249C               **  STEP 96--                                       **
23250C               **  TREAT THE X11       CASE                        **
23251C               **  REFERENCE--XXX                                  **
23252C               ******************************************************
23253C
23254 9600 CONTINUE
23255#ifdef HAVE_X11
23256      IF(ICODE.EQ.'SAVE')THEN
23257        DO9620I=1,NCSTR2
23258          CALL DPCOAN(ISTRI2(I:I),IJUNK)
23259          IADE(I)=IJUNK
23260 9620   CONTINUE
23261        IADE(NCSTR2+1)=0
23262C
23263        IERR=0
23264        CALL XSAVEG(IADE,IERR)
23265        IF(IERR.EQ.1)THEN
23266          WRITE(ICOUT,999)
23267          CALL DPWRST('XXX','BUG ')
23268          WRITE(ICOUT,9651)
23269          CALL DPWRST('XXX','BUG ')
23270          IERROR='YES'
23271          GOTO9000
23272 9651 FORMAT('***** ERROR IN DPSAPL--WRITING BIT MAP UNSUCCESSFUL.')
23273          ELSEIF(IERR.EQ.2)THEN
23274            WRITE(ICOUT,999)
23275            CALL DPWRST('XXX','BUG ')
23276            WRITE(ICOUT,9661)
23277            CALL DPWRST('XXX','BUG ')
23278            IERROR='YES'
23279            GOTO9000
23280 9661 FORMAT('***** ERROR IN DPSAPL--NO CURRENT PIXMAP TO SAVE.')
23281        ELSEIF(IERR.EQ.3)THEN
23282          WRITE(ICOUT,999)
23283          CALL DPWRST('XXX','BUG ')
23284          WRITE(ICOUT,9671)
23285          CALL DPWRST('XXX','BUG ')
23286          IERROR='YES'
23287          GOTO9000
23288 9671 FORMAT('***** ERROR IN DPSAPL--X11 HAS NOT BEEN OPENED.')
23289        ELSEIF(IERR.EQ.4)THEN
23290          WRITE(ICOUT,999)
23291          CALL DPWRST('XXX','BUG ')
23292          WRITE(ICOUT,9681)
23293          CALL DPWRST('XXX','BUG ')
23294          IERROR='YES'
23295          GOTO9000
23296 9681 FORMAT('***** ERROR IN DPSAPL--X11 NOT INSTALLED ON THIS ',
23297     1'IMPLEMENTATION.')
23298        ELSE
23299          WRITE(ICOUT,999)
23300          CALL DPWRST('XXX','BUG ')
23301          WRITE(ICOUT,9691)
23302          CALL DPWRST('XXX','BUG ')
23303          WRITE(ICOUT,9692)ISTRI2(1:NCSTR2)
23304          CALL DPWRST('XXX','BUG ')
23305          IERROR='YES'
23306          GOTO9000
23307        ENDIF
23308 9691 FORMAT('***** CURRENT PIXMAP SUCCESSFULLY SAVED TO FILE ')
23309 9692 FORMAT('      ',A128)
23310C
23311      ELSEIF(ICODE.EQ.'REST')THEN
23312        DO9729I=1,8
23313          IWIND(I)=-1
23314 9729   CONTINUE
23315        ICOUNT=0
23316        IF(IX11W2.EQ.'        ')GOTO9739
23317        CJUNK(1:8)=IX11W2(1:8)
23318        ICOUNT=0
23319        DO9730I=8,1,-1
23320          IA=CJUNK(I:I)
23321          IF(IA.EQ.' ')GOTO9730
23322          ICOUNT=ICOUNT+1
23323          CALL DPCOAN(IA,IVALUE)
23324          IF(IVALUE.GE.48.AND.IVALUE.LE.57)THEN
23325            IWIND(ICOUNT)=IVALUE-48
23326          ELSEIF(IVALUE.GE.65.AND.IVALUE.LE.70)THEN
23327            IWIND(ICOUNT)=IVALUE-55
23328          ELSEIF(IVALUE.GE.97.AND.IVALUE.LE.102)THEN
23329            IWIND(ICOUNT)=IVALUE-87
23330          ELSE
23331            ICOUNT=1
23332            WRITE(ICOUT,9733)
23333            GOTO9739
23334          ENDIF
23335 9730   CONTINUE
23336 9733 FORMAT('***** WARNING--INVALID WINDOW ID FROM FRONT-END.  ',
23337     1'A SEPARATE GRAPHICS WINDOW WILL BE OPENED.')
23338 9739   CONTINUE
23339        DO9715I=1,NCTEMP
23340          CALL DPCOAN(CTEMP(I:I),IADE2(I))
23341 9715   CONTINUE
23342        DO9720I=1,NCSTR2
23343          CALL DPCOAN(ISTRI2(I:I),IADE(I))
23344          CALL DPCOAN(ISTRI2(I:I),IADE2(I+NCTEMP))
23345 9720   CONTINUE
23346        IADE(NCSTR2+1)=0
23347        IADE2(NCSTR2+NCTEMP+1)=0
23348C
23349        IERR=0
23350        CALL XRESTG(IADE,IADE2,IWIND,ICOUNT,IERR)
23351        IF(IERR.EQ.1)THEN
23352          WRITE(ICOUT,999)
23353          CALL DPWRST('XXX','BUG ')
23354          WRITE(ICOUT,9751)
23355          CALL DPWRST('XXX','BUG ')
23356          IERROR='YES'
23357          GOTO9000
23358 9751 FORMAT('***** ERROR IN DPREGR--READING BIT MAP UNSUCCESSFUL.')
23359        ELSEIF(IERR.EQ.2)THEN
23360          WRITE(ICOUT,999)
23361          CALL DPWRST('XXX','BUG ')
23362          WRITE(ICOUT,9761)
23363          CALL DPWRST('XXX','BUG ')
23364          IERROR='YES'
23365          GOTO9000
23366 9761 FORMAT('***** ERROR IN DPREGR--NO CURRENT PIXMAP TO SAVE.')
23367        ELSEIF(IERR.EQ.3)THEN
23368          WRITE(ICOUT,999)
23369          CALL DPWRST('XXX','BUG ')
23370          WRITE(ICOUT,9771)
23371          CALL DPWRST('XXX','BUG ')
23372          IERROR='YES'
23373          GOTO9000
23374 9771 FORMAT('***** ERROR IN DPREGR--X11 HAS NOT BEEN OPENED.')
23375        ELSEIF(IERR.EQ.4)THEN
23376          WRITE(ICOUT,999)
23377          CALL DPWRST('XXX','BUG ')
23378          WRITE(ICOUT,9781)
23379          CALL DPWRST('XXX','BUG ')
23380          IERROR='YES'
23381          GOTO9000
23382 9781 FORMAT('***** ERROR IN DPREGR--X11 NOT INSTALLED ON THIS ',
23383     1'IMPLEMENTATION.')
23384        ELSEIF(IERR.EQ.5)THEN
23385          WRITE(ICOUT,999)
23386          CALL DPWRST('XXX','BUG ')
23387          WRITE(ICOUT,9786)
23388          CALL DPWRST('XXX','BUG ')
23389          IERROR='YES'
23390          GOTO9000
23391 9786 FORMAT('***** ERROR IN DPREGR--UNABLE TO OPEN NEW X11 WINDOW ')
23392        ELSE
23393          WRITE(ICOUT,999)
23394          CALL DPWRST('XXX','BUG ')
23395          WRITE(ICOUT,9791)
23396          CALL DPWRST('XXX','BUG ')
23397          WRITE(ICOUT,9792)ISTRI2(1:NCSTR2)
23398          CALL DPWRST('XXX','BUG ')
23399          IERROR='YES'
23400          GOTO9000
23401 9791 FORMAT('***** CURRENT PIXMAP SUCCESSFULLY COPIED FROM FILE ')
23402 9792 FORMAT('      ',A128)
23403        ENDIF
23404C
23405      ELSEIF(ICODE.EQ.'CYCL')THEN
23406 9800   CONTINUE
23407        IERR=0
23408        CALL XCYCLE(IERR,IBUTTN)
23409        IF(IERR.EQ.4)THEN
23410          WRITE(ICOUT,999)
23411          CALL DPWRST('XXX','BUG ')
23412          WRITE(ICOUT,9810)
23413          CALL DPWRST('XXX','BUG ')
23414          IERROR='YES'
23415          GOTO9000
23416        ELSEIF(IERR.NE.0)THEN
23417          WRITE(ICOUT,999)
23418          CALL DPWRST('XXX','BUG ')
23419          WRITE(ICOUT,9810)
23420          CALL DPWRST('XXX','BUG ')
23421          IERROR='YES'
23422          GOTO9000
23423        ENDIF
23424 9810 FORMAT('***** ERROR FROM DPCYGR: X11 NOT ACTIVE ON THIS ',
23425     1'IMPLEMENTATION.')
23426C9811 FORMAT('***** ERROR FROM DPCYGR: ERROR TRYING TO REDRAW PIXMAP.')
23427        IF(IBUTTN.EQ.1)THEN
23428          ICURPM=ICURPM-1
23429          IF(ICURPM.LT.1)ICURPM=1
23430        ELSEIF(IBUTTN.EQ.3)THEN
23431          ICURPM=ICURPM+1
23432          IF(ICURPM.GT.NUMPXM)ICURPM=NUMPXM
23433        ELSE
23434          GOTO9000
23435        ENDIF
23436C
23437        NCSTR2=1
23438        DO9905I=128,1,-1
23439          NCSTR2=I
23440          IF(IPXMFN(ICURPM)(I:I).NE.' ')GOTO9909
23441 9905   CONTINUE
23442 9909   CONTINUE
23443        CTEMP=' '
23444        IF(ICURPM.LE.9)THEN
23445          CTEMP(1:4)='  - '
23446          WRITE(CTEMP(1:1),'(I1)')ICURPM
23447          NCTEMP=4
23448        ELSEIF(ICURPM.LE.99)THEN
23449          CTEMP(1:5)='   - '
23450          WRITE(CTEMP(1:2),'(I2)')ICURPM
23451          NCTEMP=5
23452        ELSEIF(ICURPM.LE.999)THEN
23453          CTEMP(1:6)='    - '
23454          WRITE(CTEMP(1:3),'(I3)')ICURPM
23455          NCTEMP=6
23456        ENDIF
23457        DO9915I=1,NCTEMP
23458          CALL DPCOAN(CTEMP(I:I),IADE2(I))
23459 9915 CONTINUE
23460        DO9920I=1,NCSTR2
23461          CALL DPCOAN(IPXMFN(ICURPM)(I:I),IADE(I))
23462          CALL DPCOAN(IPXMFN(ICURPM)(I:I),IADE2(I+NCTEMP))
23463 9920 CONTINUE
23464        IADE(NCSTR2+1)=0
23465        IADE2(NCSTR2+NCTEMP+1)=0
23466        IERR=0
23467        DO9929I=1,8
23468          IWIND(I)=-1
23469 9929   CONTINUE
23470        ICOUNT=0
23471        IF(IX11W2.EQ.'        ')GOTO9939
23472        CJUNK(1:8)=IX11W2(1:8)
23473        ICOUNT=0
23474        DO9930I=8,1,-1
23475          IA=CJUNK(I:I)
23476          IF(IA.EQ.' ')GOTO9930
23477          ICOUNT=ICOUNT+1
23478          CALL DPCOAN(IA,IVALUE)
23479          IF(IVALUE.GE.48.AND.IVALUE.LE.57)THEN
23480            IWIND(ICOUNT)=IVALUE-48
23481          ELSEIF(IVALUE.GE.65.AND.IVALUE.LE.70)THEN
23482            IWIND(ICOUNT)=IVALUE-55
23483          ELSEIF(IVALUE.GE.99.AND.IVALUE.LE.102)THEN
23484            IWIND(ICOUNT)=IVALUE-87
23485          ELSE
23486            ICOUNT=1
23487            WRITE(ICOUT,9933)
23488            GOTO9939
23489          ENDIF
23490 9930   CONTINUE
23491 9933 FORMAT('***** WARNING--INVALID WINDOW ID FROM FRONT-END.  ',
23492     1'A SEPARATE GRAPHICS WINDOW WILL BE OPENED.')
23493 9939   CONTINUE
23494        CALL XRESTG(IADE,IADE2,IWIND,ICOUNT,IERR)
23495        IF(IERR.NE.0)THEN
23496          WRITE(ICOUT,999)
23497          CALL DPWRST('XXX','BUG ')
23498          WRITE(ICOUT,9810)
23499          CALL DPWRST('XXX','BUG ')
23500          IERROR='YES'
23501          GOTO9000
23502        ENDIF
23503C
23504        GOTO9800
23505      ENDIF
23506C
23507#endif
23508      GOTO9000
23509C
23510C               *************************************************
23511C               **  STEP 100--                                 **
23512C               **  TREAT THE VGA VIA TURBO-C       CASE       **
23513C               **  DONE VIA settextstyle in GRWRTH & GRWRTV   **
23514C               *************************************************
23515C
2351610000 CONTINUE
23517      WRITE(ICOUT,10110)
2351810110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
23519     1'GRAPH COMMANDS NOT SUPPORTED FOR VGA DEVICE.')
23520      CALL DPWRST('XXXX','BUG')
23521      GOTO9000
23522C
23523C               ******************************************************
23524C               **  STEP 110--                                      **
23525C               **  TREAT THE GKS                DRIVER             **
23526C               ******************************************************
23527C
2352811000 CONTINUE
23529      WRITE(ICOUT,11110)
2353011110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
23531     1'GRAPH COMMANDS NOT SUPPORTED FOR GKS DEVICE.')
23532      CALL DPWRST('XXXX','BUG')
23533      GOTO9000
23534C
23535C               ******************************************************
23536C               **  STEP 120--                                      **
23537C               **  TREAT THE GD                     DRIVER         **
23538C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
23539C               **  1) JPEG                                         **
23540C               **  2) PNG                                          **
23541C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
23542C               ******************************************************
23543C
2354412000 CONTINUE
23545      WRITE(ICOUT,12110)
2354612110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
23547     1'GRAPH COMMANDS NOT SUPPORTED FOR GD (=JPEG, PNG, WBMP) DEVICE.')
23548      CALL DPWRST('XXXX','BUG')
23549      GOTO9000
23550C
23551C               ******************************************************
23552C               **  STEP 130--                                      **
23553C               **  TREAT THE ABSOFT                 DRIVER         **
23554C               ******************************************************
23555C
2355613000 CONTINUE
23557      WRITE(ICOUT,13110)
2355813110 FORMAT('***** ERROR - SAVE GRAPH, REPEAT GRAPH, AND CYLCE ',
23559     1'GRAPH COMMANDS NOT SUPPORTED FOR MACINTOSH DEVICE.')
23560      CALL DPWRST('XXXX','BUG')
23561      GOTO9000
23562C
23563C               ******************************************************
23564C               **  STEP 135--                                      **
23565C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
23566C               ******************************************************
23567C
2356813500 CONTINUE
23569      GOTO9000
23570C
23571C               ******************************************************
23572C               **  STEP 150--                                      **
23573C               **  TREAT THE LATEX (EEPIC)                  DRIVER **
23574C               ******************************************************
23575C
2357615000 CONTINUE
23577      GOTO9000
23578C
23579C               ******************************************************
23580C               **  STEP 160--                                      **
23581C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
23582C               ******************************************************
23583C
2358416000 CONTINUE
23585      GOTO9000
23586C
23587C               ******************************************************
23588C               **  STEP 170--                                      **
23589C               **  TREAT THE CAIRO                          DRIVER **
23590C               ******************************************************
23591C
2359217000 CONTINUE
23593      GOTO9000
23594C
23595C               ******************************************************
23596C               **  STEP 180--                                      **
23597C               **  TREAT THE WMF                            DRIVER **
23598C               ******************************************************
23599C
2360018000 CONTINUE
23601      GOTO9000
23602C
23603C               ******************************************************
23604C               **  STEP 190--                                      **
23605C               **  TREAT THE D3                             DRIVER **
23606C               ******************************************************
23607C
2360819000 CONTINUE
23609      GOTO9000
23610C
23611C               *****************
23612C               **  STEP 90--  **
23613C               **  EXIT       **
23614C               *****************
23615C
23616 9000 CONTINUE
23617      IF(IERROR.EQ.'YES')IERRG4='YES'
23618      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SAGR')THEN
23619        WRITE(ICOUT,999)
23620        CALL DPWRST('XXX','BUG ')
23621        WRITE(ICOUT,9011)
23622 9011   FORMAT('***** AT THE END       OF GRSAGR--')
23623        CALL DPWRST('XXX','BUG ')
23624      ENDIF
23625C
23626      RETURN
23627      END
23628      SUBROUTINE GRSECA(ITYPE,ICASE,JCASE)
23629C
23630C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, SET A CASE (UPPER
23631C              OR LOWER) ON A SPECIFIC GRAPHICS DEVICE
23632C
23633C     WRITTEN BY--JAMES J. FILLIBEN
23634C                 STATISTICAL ENGINEERING DIVISION
23635C                 INFORMATION TECHNOLOGY LABORATORY
23636C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
23637C                 GAITHERSBURG, MD 20899-8980
23638C                 PHONE--301-975-2855
23639C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
23640C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
23641C     LANGUAGE--ANSI FORTRAN (1977)
23642C     VERSION NUMBER--83.6
23643C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
23644C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
23645C                                      DRIVER OBSOLETE
23646C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
23647C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
23648C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
23649C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
23650C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
23651C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
23652C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
23653C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
23654C                                      DRIVER OBSOLETE
23655C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
23656C                                      OLD CALCOMP STYLE
23657C                                      DRIVER OBSOLETE
23658C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
23659C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
23660C                                      USE BILL MITCHELLS OPENGL
23661C                                      BINDING FOR FORTRAN
23662C     UPDATED         --OCTOBER  1996. GKS (ALAN)
23663C                                      CODED, NOT TESTED
23664C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
23665C                                      PLACEHOLDER FOR NOW
23666C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
23667C                                      PLACEHOLDER FOR NOW
23668C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
23669C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
23670C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
23671C     UPDATED         --JUNE     2000. MACINTOSH
23672C                                      PLACEHOLDER FOR NOW
23673C     UPDATED         --JUNE     2000. PC PRINTER
23674C                                      PLACEHOLDER FOR NOW
23675C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
23676C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
23677C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
23678C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
23679C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
23680C
23681C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
23682C
23683#ifdef HAVE_WININTERACTER
23684      USE WINTERACTER
23685#endif
23686#ifdef HAVE_INTERACTER
23687      USE INTERACTER
23688#endif
23689      CHARACTER*4 ITYPE
23690      CHARACTER*4 ICASE
23691C
23692      CHARACTER*130 ICSTR
23693      CHARACTER*4 ISUBN0
23694C
23695C-----COMMON----------------------------------------------------------
23696C
23697      INCLUDE 'DPCOGR.INC'
23698      INCLUDE 'DPCONP.INC'
23699      INCLUDE 'DPCOBE.INC'
23700      INCLUDE 'DPCOP2.INC'
23701C
23702C-----START POINT-----------------------------------------------------
23703C
23704      ISUBN0='SECA'
23705      IERRG4='NO'
23706C
23707      NCSTR=(-999)
23708C
23709      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SECA')THEN
23710        WRITE(ICOUT,999)
23711  999   FORMAT(1X)
23712        CALL DPWRST('XXX','BUG ')
23713        WRITE(ICOUT,51)
23714   51   FORMAT('***** AT THE BEGINNING OF GRSECA--')
23715        CALL DPWRST('XXX','BUG ')
23716        WRITE(ICOUT,52)ITYPE,ICASE,IMANUF,IMODEL,IBUGG4
23717   52   FORMAT('ITYPE,ICASE,IMANUF,IMODEL,IBUGG4 = ',4(A4,2X),A4)
23718        CALL DPWRST('XXX','BUG ')
23719      ENDIF
23720C
23721C
23722C               ********************************************
23723C               **  STEP 1--                              **
23724C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
23725C               **  AND THE MODEL                         **
23726C               ********************************************
23727C
23728      IF(IMANUF.EQ.'QWIN')THEN
23729        GOTO4700
23730      ELSEIF(IMANUF.EQ.'POST')THEN
23731        GOTO8600
23732      ELSEIF(IMANUF.EQ.'X11 ')THEN
23733        GOTO9600
23734      ELSEIF(IMANUF.EQ.'AQUA')THEN
23735        GOTO13500
23736      ELSEIF(IMANUF.EQ.'GENE')THEN
23737        IF(IMODEL.EQ.'CODE')GOTO3200
23738        IF(IMODEL.EQ.'CGM')GOTO3300
23739        IF(IMODEL.EQ.'CGMB')GOTO3400
23740        GOTO3100
23741      ELSEIF(IMANUF.EQ.'SVG ')THEN
23742        GOTO16000
23743      ELSEIF(IMANUF.EQ.'GD  ')THEN
23744        GOTO12000
23745      ELSEIF(IMANUF.EQ.'LATE')THEN
23746        GOTO15000
23747      ELSEIF(IMANUF.EQ.'CAIR')THEN
23748        GOTO17000
23749      ELSEIF(IMANUF.EQ.'D3  ')THEN
23750        GOTO19000
23751      ELSEIF(IMANUF.EQ.'WMF ')THEN
23752        GOTO18000
23753      ELSEIF(IMANUF.EQ.'OPGL')THEN
23754        GOTO4800
23755      ELSEIF(IMANUF.EQ.'TEKT')THEN
23756        GOTO1100
23757      ELSEIF(IMANUF.EQ.'HP')THEN
23758        GOTO2100
23759      ELSEIF(IMANUF.EQ.'LIBP')THEN
23760        GOTO2600
23761      ELSEIF(IMANUF.EQ.'REGI')THEN
23762        GOTO8100
23763      ELSEIF(IMANUF.EQ.'GKS ')THEN
23764        GOTO11000
23765      ELSEIF(IMANUF.EQ.'LAHE')THEN
23766        IF(IMODEL.EQ.'INTE')GOTO4900
23767        IF(IMODEL.EQ.'WINT')GOTO4950
23768        GOTO4600
23769      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
23770        GOTO13000
23771      ELSEIF(IMANUF.EQ.'QUIC')THEN
23772        GOTO9100
23773      ELSEIF(IMANUF.EQ.'CALC')THEN
23774        GOTO4100
23775      ELSEIF(IMANUF.EQ.'ZETA')THEN
23776        GOTO5100
23777      ELSEIF(IMANUF.EQ.'TURB')THEN
23778        GOTO10000
23779      ELSEIF(IMANUF.EQ.'SUN ')THEN
23780        GOTO6600
23781      ENDIF
23782      GOTO9000
23783C
23784C               ******************************************************
23785C               **  STEP 11--                                       **
23786C               **  TREAT THE TEKTRONIX CASE                        **
23787C               **  REFERENCE--XXX                                  **
23788C               ******************************************************
23789C
23790 1100 CONTINUE
23791      GOTO9000
23792C
23793C               ******************************************************
23794C               **  STEP 21--                                       **
23795C               **  TREAT THE HEWLETT-PACKARD CASES                 **
23796C               ******************************************************
23797C
23798 2100 CONTINUE
23799      GOTO9000
23800C
23801C               ******************************************************
23802C               **  STEP 26--                                       **
23803C               **  TREAT THE PCL       CASE                        **
23804C               **  REFERENCE--XXX                                  **
23805C               ******************************************************
23806C
23807 2600 CONTINUE
23808      GOTO9000
23809C
23810C               ******************************************************
23811C               **  STEP 31--                                       **
23812C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
23813C               ******************************************************
23814C
23815 3100 CONTINUE
23816      WRITE(IGUNIT,3111)ICASE
23817 3111 FORMAT('SET CASE ',A4)
23818      GOTO9000
23819C
23820C               ***************************************************************
23821C               **  STEP 32--                                                **
23822C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
23823C               ***************************************************************
23824C
23825 3200 CONTINUE
23826      ICSTR(1:5)='SECA '
23827      ICSTR(6:9)=ICASE
23828      NCSTR=9
23829      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
23830      GOTO9000
23831C
23832C               ******************************************************
23833C               **  STEP 33--                                       **
23834C               **  TREAT THE CGM       CASE                        **
23835C               ******************************************************
23836C
23837 3300 CONTINUE
23838      GOTO9000
23839C
23840C               ***************************************************
23841C               **  STEP 34--                                    **
23842C               **  TREAT THE CGM (BINARY)                 CASE  **
23843C               ***************************************************
23844C
23845 3400 CONTINUE
23846      GOTO9000
23847C
23848C               ******************************************************
23849C               **  STEP 41--                                       **
23850C               **  TREAT THE CALCOMP XXXXXX CASE                   **
23851C               **  (NOT DONE)                                      **
23852C               **  REFERENCE--XX                                   **
23853C               **             XX                                   **
23854C               **             PAGES XX AND XX                      **
23855C               ******************************************************
23856C
23857 4100 CONTINUE
23858      GOTO9000
23859C
23860C               ******************************************************
23861C               **  STEP 46--                                       **
23862C               **  TREAT THE LAHEY   XXXXXX CASE                   **
23863C               **  REFERENCE--Programmer's Reference, Revision C   **
23864C               **             Lahey Computer Systems, January, 1992**
23865C               **             PAGES 51 THRU 65                     **
23866C               ******************************************************
23867C
23868 4600 CONTINUE
23869      GOTO9000
23870C
23871C               ******************************************************
23872C               **  STEP 47--                                       **
23873C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
23874C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
23875C               ******************************************************
23876C
23877 4700 CONTINUE
23878      GOTO9000
23879C
23880C               ******************************************************
23881C               **  STEP 48--                                       **
23882C               **  TREAT THE OPEN-GL DRIVER                        **
23883C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
23884C               ******************************************************
23885C
23886 4800 CONTINUE
23887      GOTO9000
23888C
23889C               ******************************************************
23890C               **  STEP 49--                                       **
23891C               **  TREAT THE LAHEY INTERACTOR CASE                 **
23892C               ******************************************************
23893C
23894 4900 CONTINUE
23895      GOTO9000
23896C
23897C               ******************************************************
23898C               **  STEP 49B-                                       **
23899C               **  TREAT THE LAHEY WINTERACTOR CASE                **
23900C               ******************************************************
23901C
23902 4950 CONTINUE
23903      GOTO9000
23904C
23905C
23906C               ******************************************************
23907C               **  STEP 51--                                       **
23908C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
23909C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
23910C               **             MODELS 3600SX AND 3653SX             **
23911C               **             PAGES B-0 AND B-1                    **
23912C               ******************************************************
23913C
23914 5100 CONTINUE
23915      GOTO9000
23916C
23917C               ******************************************************
23918C               **  STEP 66--                                       **
23919C               **  TREAT THE SUN       CASE                        **
23920C               **  REFERENCE--XXX                                  **
23921C               ******************************************************
23922C
23923 6600 CONTINUE
23924      GOTO9000
23925C
23926C               ******************************************************
23927C               **  STEP 81--                                       **
23928C               **  TREAT THE REGIS     CASE                        **
23929C               **  REFERENCE--XXX                                  **
23930C               ******************************************************
23931C
23932 8100 CONTINUE
23933      GOTO9000
23934C
23935C               ******************************************************
23936C               **  STEP 86--                                       **
23937C               **  TREAT THE POSTSCRIPT CASE                       **
23938C               **  REFERENCE--XXX                                  **
23939C               ******************************************************
23940C
23941 8600 CONTINUE
23942      GOTO9000
23943C
23944C               ******************************************************
23945C               **  STEP 91--                                       **
23946C               **  TREAT THE QUIC      CASE                        **
23947C               **  REFERENCE--XXX                                  **
23948C               ******************************************************
23949C
23950 9100 CONTINUE
23951      GOTO9000
23952C
23953C
23954C               ******************************************************
23955C               **  STEP 96--                                       **
23956C               **  TREAT THE X11       CASE                        **
23957C               **  REFERENCE--XXX                                  **
23958C               ******************************************************
23959C
23960 9600 CONTINUE
23961      GOTO9000
23962C
23963C               *************************************************
23964C               **  STEP 100--                                 **
23965C               **  TREAT THE VGA VIA TURBO-C       CASE       **
23966C               *************************************************
23967C
2396810000 CONTINUE
23969CTURB CALL TCSECA(ICASE)
23970      GOTO9000
23971C
23972C               ******************************************************
23973C               **  STEP 110--                                      **
23974C               **  TREAT THE GKS                DRIVER             **
23975C               ******************************************************
23976C
2397711000 CONTINUE
23978      GOTO9000
23979C
23980C               ******************************************************
23981C               **  STEP 120--                                      **
23982C               **  TREAT THE GD                     DRIVER         **
23983C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
23984C               **  1) JPEG                                         **
23985C               **  2) PNG                                          **
23986C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
23987C               ******************************************************
23988C
2398912000 CONTINUE
23990      GOTO9000
23991C
23992C               ******************************************************
23993C               **  STEP 130--                                      **
23994C               **  TREAT THE ABSOFT                 DRIVER         **
23995C               ******************************************************
23996C
2399713000 CONTINUE
23998      GOTO9000
23999C
24000C               ******************************************************
24001C               **  STEP 135--                                      **
24002C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
24003C               ******************************************************
24004C
2400513500 CONTINUE
24006      GOTO9000
24007C
24008C               ******************************************************
24009C               **  STEP 150--                                      **
24010C               **  TREAT THE LATEX (EEPIC)                  DRIVER **
24011C               ******************************************************
24012C
2401315000 CONTINUE
24014      GOTO9000
24015C
24016C               ******************************************************
24017C               **  STEP 160--                                      **
24018C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
24019C               ******************************************************
24020C
2402116000 CONTINUE
24022      GOTO9000
24023C
24024C               ******************************************************
24025C               **  STEP 170--                                      **
24026C               **  TREAT THE CAIRO                          DRIVER **
24027C               ******************************************************
24028C
2402917000 CONTINUE
24030      GOTO9000
24031C
24032C               ******************************************************
24033C               **  STEP 180--                                      **
24034C               **  TREAT THE WMF                            DRIVER **
24035C               ******************************************************
24036C
2403718000 CONTINUE
24038      GOTO9000
24039C
24040C               ******************************************************
24041C               **  STEP 190--                                      **
24042C               **  TREAT THE D3                             DRIVER **
24043C               ******************************************************
24044C
2404519000 CONTINUE
24046      GOTO9000
24047C
24048C               *****************
24049C               **  STEP 90--  **
24050C               **  EXIT       **
24051C               *****************
24052C
24053 9000 CONTINUE
24054      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SECA')THEN
24055        WRITE(ICOUT,999)
24056        CALL DPWRST('XXX','BUG ')
24057        WRITE(ICOUT,9011)
24058 9011   FORMAT('***** AT THE END       OF GRSECA--')
24059        CALL DPWRST('XXX','BUG ')
24060        WRITE(ICOUT,9013)IERRG4,JCASE
24061 9013   FORMAT('IERRG4,JCASE = ',A4,2X,I8)
24062        CALL DPWRST('XXX','BUG ')
24063      ENDIF
24064C
24065      RETURN
24066      END
24067      SUBROUTINE GRSECO(ICASE,ICOL,JCOL)
24068C
24069C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, SET A COLOR
24070C              ON A SPECIFIC GRAPHICS DEVICE
24071C
24072C     WRITTEN BY--JAMES J. FILLIBEN
24073C                 STATISTICAL ENGINEERING DIVISION
24074C                 INFORMATION TECHNOLOGY LABORATORY
24075C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
24076C                 GAITHERSBURG, MD 20899-8980
24077C                 PHONE--301-975-2855
24078C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
24079C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
24080C     LANGUAGE--ANSI FORTRAN (1977)
24081C     VERSION NUMBER--83.6
24082C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
24083C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
24084C                                      DRIVER OBSOLETE
24085C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
24086C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
24087C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
24088C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
24089C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
24090C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
24091C     UPDATED         --JULY     1990. SUPPORT COLOR FOR SOME HP-2622 DEVICES
24092C     UPDATED         --JANUARY  1991. SUPPORT COLOR ON REGIS (ALAN)
24093C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
24094C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
24095C                                      DRIVER OBSOLETE
24096C     UPDATED         --APRIL    1992. FIX DEBUG CODE
24097C     UPDATED         --AUGUST   1992. POSTSCRIPT TO HANDLE FULL SET OF
24098C                                      COLORS (ALAN)
24099C     UPDATED         --MARCH    1993. POSTSCRIPT (HANDLE GRAY SCALE
24100C                                      DIFFERENTLY ON BLACK AND WHITE
24101C                                      AND COLOR DEVICES)
24102C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
24103C                                      OLD STYLE CALCOMP
24104C                                      DRIVER OBSOLETE
24105C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
24106C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
24107C                                      USE BILL MITCHELLS OPENGL
24108C                                      BINDING FOR FORTRAN
24109C     UPDATED         --OCTOBER  1996. GKS (ALAN)
24110C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
24111C                                      PLACEHOLDER FOR NOW
24112C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
24113C                                      USE BILL MITCHELLS OPENGL
24114C                                      BINDING FOR FORTRAN
24115C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
24116C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
24117C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
24118C     UPDATED         --JUNE     2000. MACINTOSH
24119C                                      PLACEHOLDER FOR NOW
24120C     UPDATED         --JUNE     2000. PC PRINTER
24121C                                      PLACEHOLDER FOR NOW
24122C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
24123C     UPDATED         --LATEK    2006. LATEX COLOR
24124C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
24125C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
24126C     UPDATED         --MAY      2012. ADD SUPPORT FOR:
24127C                                         R0 - R255   - 1000 TO 1255
24128C                                         Z0 - Z255   - 2000 TO 2255
24129C                                         B0 - B255   - 3000 TO 3255
24130C                                      THIS ADDS SHADING TO PRIMRY COLORS
24131C                                      SIMILAR TO GRAY SCALE.  A BIT OF A
24132C                                      STOP GAP TO IMPLEMENTING FULL RGB
24133C                                      SUPPORT.
24134C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
24135C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
24136C
24137C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
24138C
24139#ifdef HAVE_WININTERACTER
24140      USE WINTERACTER
24141#endif
24142#ifdef HAVE_INTERACTER
24143      USE INTERACTER
24144#endif
24145#ifdef HAVE_QWIN
24146CQWIN USE DFLIB
24147      USE IFQWIN
24148#endif
24149C
24150      CHARACTER*4 ICASE
24151      CHARACTER*4 ICOL
24152      CHARACTER*1 ICOL2
24153      CHARACTER*130 ICSTR
24154      CHARACTER*4 ISUBN0
24155      INTEGER RD(8),GN(8),BE(8)
24156      INTEGER RED(8),GRN(8),BLE(8)
24157      PARAMETER(MAXCLR=89)
24158      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
24159C
24160C-----COMMON----------------------------------------------------------
24161C
24162      INCLUDE 'DPCOPA.INC'
24163      INCLUDE 'DPCOGR.INC'
24164      INCLUDE 'DPCONP.INC'
24165      INCLUDE 'DPCOBE.INC'
24166      INCLUDE 'DPCODV.INC'
24167      INCLUDE 'DPCOF2.INC'
24168C
24169C  AUGUST 1992.  DEFINE COLORS FOR POSTSCRIPT (CGM SETS COLOR TABLE
24170C  IN GRINDE AND GRERSC).
24171C
24172      INCLUDE 'DPCOCT.INC'
24173      INCLUDE 'DPCOP2.INC'
24174C
24175C-----START POINT-----------------------------------------------------
24176C
24177      ISUBN0='SECO'
24178      IERRG4='NO'
24179C
24180      NCSTR=(-999)
24181      JCOL2=0
24182      ICOL2=' '
24183      IUNIT=(-999)
24184      ITEN=(-999)
24185C
24186      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SECO')THEN
24187        WRITE(ICOUT,999)
24188  999   FORMAT(1X)
24189        CALL DPWRST('XXX','BUG ')
24190        WRITE(ICOUT,51)
24191   51   FORMAT('***** AT THE BEGINNING OF GRSECO--')
24192        CALL DPWRST('XXX','BUG ')
24193        WRITE(ICOUT,52)ICASE,ICOL,IBUGG4
24194   52   FORMAT('ICASE,ICOL,IBUGG4 = ',2(A4,2X),A4)
24195        CALL DPWRST('XXX','BUG ')
24196        WRITE(ICOUT,54)IMANUF,IMODEL,IGUNIT
24197   54   FORMAT('IMANUF,IMODEL,IGUNIT = ',2(A4,2X),I8)
24198        CALL DPWRST('XXX','BUG ')
24199      ENDIF
24200C
24201C        ********************************************
24202C        **  STEP 1--                              **
24203C        **  BRANCH ACCORDING TO THE MANUFACTURER  **
24204C        **  AND THE MODEL                         **
24205C        ********************************************
24206C
24207      IF(IMANUF.EQ.'QWIN')THEN
24208        GOTO4700
24209      ELSEIF(IMANUF.EQ.'POST')THEN
24210        GOTO8600
24211      ELSEIF(IMANUF.EQ.'X11 ')THEN
24212        GOTO9600
24213      ELSEIF(IMANUF.EQ.'AQUA')THEN
24214        GOTO13500
24215      ELSEIF(IMANUF.EQ.'GENE')THEN
24216        IF(IMODEL.EQ.'CODE')GOTO3200
24217        IF(IMODEL.EQ.'CGM')GOTO3300
24218        IF(IMODEL.EQ.'CGMB')GOTO3400
24219        GOTO3100
24220      ELSEIF(IMANUF.EQ.'SVG ')THEN
24221        GOTO16000
24222      ELSEIF(IMANUF.EQ.'GD  ')THEN
24223        GOTO12000
24224      ELSEIF(IMANUF.EQ.'LATE')THEN
24225        GOTO15000
24226      ELSEIF(IMANUF.EQ.'CAIR')THEN
24227        GOTO17000
24228      ELSEIF(IMANUF.EQ.'D3  ')THEN
24229        GOTO19000
24230      ELSEIF(IMANUF.EQ.'WMF ')THEN
24231        GOTO18000
24232      ELSEIF(IMANUF.EQ.'OPGL')THEN
24233        GOTO4800
24234      ELSEIF(IMANUF.EQ.'TEKT')THEN
24235        IF(IMODEL.EQ.'4662')GOTO1100
24236C
24237        IF(IMODEL.EQ.'4027')GOTO1200
24238C
24239        IF(IMODEL.EQ.'4105')GOTO1300
24240        IF(IMODEL.EQ.'4107')GOTO1300
24241        IF(IMODEL.EQ.'4109')GOTO1300
24242        IF(IMODEL.EQ.'4115')GOTO1300
24243        IF(IMODEL.EQ.'4107')GOTO1300
24244        IF(IMODEL.EQ.'4113')GOTO1300
24245C
24246        GOTO9000
24247      ELSEIF(IMANUF.EQ.'HP')THEN
24248        IF(IMODEL.EQ.'7221')GOTO2100
24249        IF(IMODEL.EQ.'2622')GOTO2300
24250        IF(IMODEL.EQ.'2623')GOTO2300
24251        IF(IMODEL.EQ.'2627')GOTO2300
24252        IF(IMODEL.EQ.'2647')GOTO2300
24253        GOTO2200
24254      ELSEIF(IMANUF.EQ.'LIBP')THEN
24255        GOTO2600
24256      ELSEIF(IMANUF.EQ.'REGI')THEN
24257        GOTO8100
24258      ELSEIF(IMANUF.EQ.'GKS ')THEN
24259        GOTO11000
24260      ELSEIF(IMANUF.EQ.'LAHE')THEN
24261        IF(IMODEL.EQ.'INTE')GOTO4900
24262        IF(IMODEL.EQ.'WINT')GOTO4950
24263        GOTO4600
24264      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
24265        GOTO13000
24266      ELSEIF(IMANUF.EQ.'QUIC')THEN
24267        GOTO9100
24268      ELSEIF(IMANUF.EQ.'CALC')THEN
24269        GOTO4100
24270      ELSEIF(IMANUF.EQ.'ZETA')THEN
24271        GOTO5100
24272      ELSEIF(IMANUF.EQ.'TURB')THEN
24273        GOTO10000
24274      ELSEIF(IMANUF.EQ.'SUN ')THEN
24275        GOTO6600
24276      ENDIF
24277      GOTO9000
24278C
24279C        ******************************************************
24280C        **  STEP 11--                                       **
24281C        **  TREAT THE TEKTRONIX 4662                        **
24282C        **  (A PENPLOTTER).                                 **
24283C        **  REFERENCE--XXX                                  **
24284C        ******************************************************
24285C
24286 1100 CONTINUE
24287C
24288      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)JCOL=2
24289      IF(JCOL.GE.2000 .AND. JCOL.LE.2999)JCOL=4
24290      IF(JCOL.GE.3000 .AND. JCOL.LE.3999)JCOL=3
24291      ICSTR(1:1)=IESCC
24292      ICSTR(2:4)='ABP'
24293      IX=JCOL+48
24294      CALL DPCONA(IX,ICSTR(5:5))
24295      NCSTR=5
24296      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
24297      GOTO9000
24298C
24299C        ******************************************************
24300C        **  STEP 12--                                       **
24301C        **  TREAT THE TEKTRONIX 4027                        **
24302C        **  (COLOR RASTER DEVICE).                          **
24303C        **  REFERENCE--XXX                                  **
24304C        ******************************************************
24305C
24306 1200 CONTINUE
24307      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)JCOL=1
24308      IF(JCOL.GE.2000 .AND. JCOL.LE.2999)JCOL=2
24309      IF(JCOL.GE.3000 .AND. JCOL.LE.3999)JCOL=3
24310C
24311      IF(ICASE.EQ.'LINE' .OR. ICASE.EQ.'REGI' .OR.
24312     1   ICASE.EQ.'BACK' .OR. ICASE.EQ.'FORE' .OR.
24313     1   ICASE.EQ.'MARK')THEN
24314        ICSTR(1:6)='!COL C'
24315        IX=JCOL+48
24316        CALL DPCONA(IX,ICSTR(7:7))
24317        NCSTR=7
24318        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
24319      ELSEIF(ICASE.EQ.'TEXT')THEN
24320        ICSTR(1:6)='!ATT C'
24321        IX=JCOL+48
24322        CALL DPCONA(IX,ICSTR(7:7))
24323        NCSTR=7
24324        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
24325      ENDIF
24326      GOTO9000
24327C
24328C        ******************************************************
24329C        **  STEP 13--                                       **
24330C        **  TREAT THE TEKTRONIX 4105                        **
24331C        **  (COLOR RASTER DEVICE).                          **
24332C        **  REFERENCE--PAGE 5-45 (LINE), 5-50 (TEXT),       **
24333C        **             5-32 (REGION)                        **
24334C        ******************************************************
24335C
24336 1300 CONTINUE
24337      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)JCOL=2
24338      IF(JCOL.GE.2000 .AND. JCOL.LE.2999)JCOL=3
24339      IF(JCOL.GE.3000 .AND. JCOL.LE.3999)JCOL=4
24340C
24341      IF(ICASE.EQ.'REGI' .OR. ICASE.EQ.'BACK')THEN
24342        IF(JCOL.EQ.0)JCOL2=48
24343        IF(JCOL.NE.0)JCOL2=JCOL+32
24344        CALL DPCONA(JCOL2,ICOL2)
24345        ICSTR(1:1)=IESCC
24346        ICSTR(2:3)='MP'
24347        IX=JCOL+48
24348        CALL DPCONA(IX,ICSTR(4:4))
24349        NCSTR=4
24350        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
24351      ELSEIF(ICASE.EQ.'TEXT')THEN
24352        ICSTR(1:1)=IESCC
24353        ICSTR(2:3)='MT'
24354        IX=JCOL+48
24355        CALL DPCONA(IX,ICSTR(4:4))
24356        NCSTR=4
24357        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
24358      ELSE
24359        ICSTR(1:1)=IESCC
24360        ICSTR(2:3)='ML'
24361        IX=JCOL+48
24362        CALL DPCONA(IX,ICSTR(4:4))
24363        NCSTR=4
24364        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
24365      ENDIF
24366      GOTO9000
24367C
24368C
24369C
24370C        ******************************************************
24371C        **  STEP 21--                                       **
24372C        **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
24373C        **  (MULTI-COLOR PENPLOTTER)                        **
24374C        **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
24375C        **             OPERATING AND PROGRAMMING MANUAL,    **
24376C        **             PAGE 73.                             **
24377C        ******************************************************
24378C
24379 2100 CONTINUE
24380C
24381      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)JCOL=2
24382      IF(JCOL.GE.2000 .AND. JCOL.LE.2999)JCOL=4
24383      IF(JCOL.GE.3000 .AND. JCOL.LE.3999)JCOL=3
24384C
24385      JCOL2=JCOL+64
24386      CALL DPCONA(JCOL2,ICOL2)
24387      ICSTR(1:1)='v'
24388      ICSTR(2:2)=ICOL2
24389      ICSTR(3:3)='}'
24390      NCSTR=3
24391      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
24392      GOTO9000
24393C
24394C        ******************************************************
24395C        **  STEP 22--                                       **
24396C        **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
24397C        **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
24398C        **  (MULTI-COLOR PENPLOTTERS)                       **
24399C        **  TO SET COLOR--                                  **
24400C        **  WRITE OUT A    SP     PEN NUMBER                **
24401C        **  (WITH A TRAILING SEMI-COLON WHICH IS THE        **
24402C        **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
24403C        **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
24404C        **             OPERATING AND PROGRAMMING MANUAL,    **
24405C        **             PAGE 61, 144.                        **
24406C        ******************************************************
24407C
24408 2200 CONTINUE
24409C
24410      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)JCOL=2
24411      IF(JCOL.GE.2000 .AND. JCOL.LE.2999)JCOL=4
24412      IF(JCOL.GE.3000 .AND. JCOL.LE.3999)JCOL=3
24413C
24414      ICSTR(1:2)='SP'
24415      IX=JCOL+48
24416      CALL DPCONA(IX,ICSTR(3:3))
24417      ICSTR(4:4)=';'
24418      NCSTR=4
24419      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
24420      GOTO9000
24421C
24422C        **********************************************************
24423C        **  STEP 23--                                           **
24424C        **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
24425C        **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
24426C        **  (MONOCHROME DISPLAY TERMINALS)                      **
24427C        **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
24428C        **             REFERENCE MANUAL,                        **
24429C        **             PAGE XX-X, XXX.                          **
24430C        **********************************************************
24431C
24432 2300 CONTINUE
24433      IF(IGCOLO.NE.'ON')GOTO9000
24434      IF(ICASE.EQ.'BACK')GOTO9000
24435C
24436      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)JCOL=1
24437      IF(JCOL.GE.2000 .AND. JCOL.LE.2999)JCOL=2
24438      IF(JCOL.GE.3000 .AND. JCOL.LE.3999)JCOL=3
24439C
24440      ICSTR(1:1)=IESCC
24441      ICSTR(2:3)='*m'
24442      NCSTR=3
24443      NCHTOT=1
24444      CALL GRTRIN(JCOL,NCHTOT,ICSTR,NCSTR)
24445      NCSTR=NCSTR+1
24446      ICSTR(NCSTR:NCSTR)='X'
24447      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
24448      GOTO9000
24449C
24450C        ******************************************************
24451C        **  STEP 26--                                       **
24452C        **  TREAT THE UNIX LIBPLOT CASE                     **
24453C        ******************************************************
24454C
24455 2600 CONTINUE
24456C
24457      IFACT=65535/255
24458      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)THEN
24459        IVALR=IFACT*(JCOL - 1000)
24460        IVALG=0
24461        IVALB=0
24462      ELSEIF(JCOL.GE.2000 .AND. JCOL.LE.2999)THEN
24463        IVALR=0
24464        IVALG=IFACT*(JCOL - 2000)
24465        IVALB=0
24466      ELSEIF(JCOL.GE.3000 .AND. JCOL.LE.3999)THEN
24467        IVALR=0
24468        IVALG=0
24469        IVALB=IFACT*(JCOL - 3000)
24470      ELSE
24471        IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JCOL=1
24472        IVALR=IFACT*IRED(JCOL)
24473        IVALG=IFACT*IGREEN(JCOL)
24474        IVALB=IFACT*IBLUE(JCOL)
24475      ENDIF
24476      ITYPE=0
24477      IF(ICASE.EQ.'REGI')ITYPE=1
24478C
24479#ifdef HAVE_LIBPLOT
24480      CALL PLSECO(IVALR,IVALG,IVALB)
24481#endif
24482      GOTO9000
24483C
24484C        ******************************************************
24485C        **  STEP 31--                                       **
24486C        **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
24487C        ******************************************************
24488C
24489 3100 CONTINUE
24490C
24491C  NOTE: BACKGROUND COLOR SET WHEN ERASE SCREEN DONE.  SKIP HERE
24492      IF(ICASE.EQ.'BACK')GOTO9000
24493C
24494      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)ICOL='RED'
24495      IF(JCOL.GE.2000 .AND. JCOL.LE.2999)ICOL='GREE'
24496      IF(JCOL.GE.3000 .AND. JCOL.LE.3999)ICOL='BLUE'
24497C
24498      ICSTR(1:10)='SET COLOR '
24499      ICSTR(11:14)=ICASE
24500      ICSTR(15:16)='  '
24501      ICSTR(17:20)=ICOL
24502      NCSTR=20
24503      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
24504      GOTO9000
24505C
24506C        ***************************************************************
24507C        **  STEP 32--                                                **
24508C        **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
24509C        ***************************************************************
24510C
24511 3200 CONTINUE
24512C  NOTE: BACKGROUND COLOR SET WHEN ERASE SCREEN DONE.  SKIP HERE
24513      IF(ICASE.EQ.'BACK')GOTO9000
24514C
24515      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)ICOL='RED'
24516      IF(JCOL.GE.2000 .AND. JCOL.LE.2999)ICOL='GREE'
24517      IF(JCOL.GE.3000 .AND. JCOL.LE.3999)ICOL='BLUE'
24518C
24519      ICSTR(1:5)='SECO '
24520      ICSTR(6:9)=ICASE
24521      ICSTR(10:10)=' '
24522      ICSTR(11:14)=ICOL
24523      NCSTR=14
24524      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
24525      GOTO9000
24526C
24527C        ******************************************************
24528C        **  STEP 33--                                       **
24529C        **  TREAT THE CGM CASE                              **
24530C        ******************************************************
24531C
24532 3300 CONTINUE
24533C
24534      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)JCOL=3
24535      IF(JCOL.GE.2000 .AND. JCOL.LE.2999)JCOL=5
24536      IF(JCOL.GE.3000 .AND. JCOL.LE.3999)JCOL=4
24537C
24538      IF(ICASE.EQ.'REGI')THEN
24539        ICSTR(1:9)='FILLCOLR '
24540        NCHTOT=2
24541        NCSTR=9
24542        CALL GRTRIN(JCOL,NCHTOT,ICSTR,NCSTR)
24543        ICSTR(12:12)=';'
24544        NCSTR=12
24545        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
24546      ELSEIF(ICASE.EQ.'MARK' .OR. ICASE.EQ.'TEXT')THEN
24547        ICSTR(1:9)='TEXTCOLR '
24548        NCHTOT=2
24549        NCSTR=9
24550        CALL GRTRIN(JCOL,NCHTOT,ICSTR,NCSTR)
24551        ICSTR(12:12)=';'
24552        NCSTR=12
24553        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
24554      ELSEIF(ICASE.EQ.'BACK')THEN
24555C       NOTE: BACKGROUND COLOR SET WHEN ERASE SCREEN DONE.  SKIP HERE
24556        CONTINUE
24557      ELSE
24558        ICSTR(1:9)='LINECOLR '
24559        NCHTOT=2
24560        NCSTR=9
24561        CALL GRTRIN(JCOL,NCHTOT,ICSTR,NCSTR)
24562        ICSTR(12:12)=';'
24563        NCSTR=12
24564        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
24565      ENDIF
24566C
24567      GOTO9000
24568C
24569C        ***************************************************
24570C        **  STEP 34--                                    **
24571C        **  TREAT THE CGM (BINARY)                 CASE  **
24572C        ***************************************************
24573C
24574 3400 CONTINUE
24575      GOTO9000
24576C
24577C        ******************************************************
24578C        **  STEP 41--                                       **
24579C        **  TREAT THE CALCOMP XXXXXX CASE                   **
24580C        **  TO SET COLOR--                                  **
24581C        **  WRITE OUT AN XXXXXXXXXX                         **
24582C        **  (NOT DONE)                                      **
24583C        **  REFERENCE--XX                                   **
24584C        **             XX                                   **
24585C        **             PAGES XX AND XX                      **
24586C        **  USE CALCOMP LIBRARY ROUTINES                    **
24587C        ******************************************************
24588C
24589 4100 CONTINUE
24590      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)JCOL=2
24591      IF(JCOL.GE.2000 .AND. JCOL.LE.2999)JCOL=4
24592      IF(JCOL.GE.3000 .AND. JCOL.LE.3999)JCOL=3
24593C
24594      IF(ICASE.EQ.'BACK' .OR. JCOL.EQ.ICALCC)GOTO9000
24595#ifdef HAVE_CALCOMP
24596      CALL NEWPEN(JCOL)
24597#endif
24598      ICALCC=JCOL
24599      GOTO9000
24600C
24601C        ******************************************************
24602C        **  STEP 46--                                       **
24603C        **  TREAT THE LAHEY   XXXXXX CASE                   **
24604C        **  REFERENCE--Programmer's Reference, Revision C   **
24605C        **             Lahey Computer Systems, January, 1992**
24606C        **             PAGES 51 THRU 65                     **
24607C        ******************************************************
24608C
24609 4600 CONTINUE
24610      IF(ICASE.EQ.'BACK')GOTO9000
24611C
24612      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)JCOL=2
24613      IF(JCOL.GE.2000 .AND. JCOL.LE.2999)JCOL=4
24614      IF(JCOL.GE.3000 .AND. JCOL.LE.3999)JCOL=3
24615C
24616      IF(JCOL.NE.ILAHCC)THEN
24617#ifdef HAVE_LAHEY_CALCOMP
24618        CALL NEWPEN(JCOL)
24619#endif
24620        ILAHCC=JCOL
24621      ENDIF
24622      GOTO9000
24623C
24624C        ******************************************************
24625C        **  STEP 47--                                       **
24626C        **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
24627C        **  FOR WINDOWS 95 AND WINDOWS NT.                  **
24628C        ******************************************************
24629C
24630 4700 CONTINUE
24631C
24632      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)THEN
24633        IREDT=JCOL - 1000
24634        IGREET=0
24635        IBLUET=0
24636      ELSEIF(JCOL.GE.2000 .AND. JCOL.LE.2999)THEN
24637        IREDT=0
24638        IGREET=JCOL - 2000
24639        IBLUET=0
24640      ELSEIF(JCOL.GE.3000 .AND. JCOL.LE.3999)THEN
24641        IREDT=0
24642        IGREET=0
24643        IBLUET=JCOL - 3000
24644      ELSE
24645        IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JCOL=1
24646        IREDT=IRED(JCOL)
24647        IGREET=IGREEN(JCOL)
24648        IBLUET=IBLUE(JCOL)
24649      ENDIF
24650C
24651      IF(ICASE.EQ.'BACK')GOTO9000
24652#ifdef HAVE_QWIN
24653      IF(IQWNCL.EQ.'VGA')THEN
24654        ISTATUS=SETCOLOR(INT2(JCOL))
24655      ELSEIF(IQWNCL.EQ.'RGB')THEN
24656        IF(JCOL.GE.0)THEN
24657          JTEMP=RGBTOINTEGER(IREDT,IGREER,IBLUET)
24658          ISTATUS=SETCOLORRGB(JTEMP)
24659        ELSE
24660          AVAL=ABS(REAL(JCOL)/100.)*255.
24661          IVAL=INT(AVAL+0.5)
24662          IF(IVAL.LT.0)IVAL=0
24663          IF(IVAL.GT.255)IVAL=255
24664          JTEMP=IVAL
24665          JTEMP2=RGBTOINTEGER(JTEMP,JTEMP,JTEMP)
24666          ISTATUS=SETCOLORRGB(JTEMP2)
24667        ENDIF
24668      ELSE
24669        ISTATUS=SETCOLOR(INT2(JCOL))
24670      ENDIF
24671#endif
24672      GOTO9000
24673C
24674C        ******************************************************
24675C        **  STEP 48--                                       **
24676C        **  TREAT THE OPEN-GL DRIVER                        **
24677C        **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
24678C        ******************************************************
24679C
24680 4800 CONTINUE
24681C
24682      ATEMP=255.0
24683      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)THEN
24684        ARED=REAL(JCOL - 1000)/ATEMP
24685        AGREEN=0.0
24686        ABLUE=0.0
24687      ELSEIF(JCOL.GE.2000 .AND. JCOL.LE.2999)THEN
24688        ARED=0.0
24689        AGREEN=REAL(JCOL - 2000)/ATEMP
24690        ABLUE=0.0
24691      ELSEIF(JCOL.GE.3000 .AND. JCOL.LE.3999)THEN
24692        ARED=0.0
24693        AGREEN=0.0
24694        ABLUE=REAL(JCOL - 3000)/ATEMP
24695      ELSE
24696        IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JCOL=1
24697        ARED=REAL(IRED(JCOL))/ATEMP
24698        AGREEN=REAL(IGREEN(JCOL))/ATEMP
24699        ABLUE=REAL(IBLUE(JCOL))/ATEMP
24700      ENDIF
24701C
24702      IF(ICASE.EQ.'BACK')GOTO9000
24703#ifdef HAVE_OPEN_GL
24704      CALL GLSECO(JCOL,ARED,AGREEN,ABLUE)
24705#endif
24706      GOTO9000
24707C
24708C        ******************************************************
24709C        **  STEP 49--                                       **
24710C        **  TREAT THE LAHEY INTERACTOR CASE                 **
24711C        ******************************************************
24712C
24713 4900 CONTINUE
24714#ifdef HAVE_INTERACTER
24715      CALL IGrColourN(JCOL)
24716#endif
24717      GOTO9000
24718C
24719C        ******************************************************
24720C        **  STEP 49B-                                       **
24721C        **  TREAT THE LAHEY WINTERACTOR CASE                **
24722C        ******************************************************
24723C
24724 4950 CONTINUE
24725      IF(ICASE.EQ.'BACK')GOTO9000
24726#ifdef HAVE_WINTERACTER
24727      IF(JCOL.LT.0)THEN
24728        AVAL=REAL(JCOL)/100.
24729        AVAL=ABS(AVAL)
24730        IF(AVAL.LE.0.0)AVAL=0.0
24731        IF(AVAL.GE.1.0)AVAL=1.0
24732        ITEMP=INT(255.*AVAL + 0.5)
24733        IJUNK=MAXCLR+1
24734        IF(IWINCL.EQ.'RGB')THEN
24735          CALL IGrPaletteRGB(IJUNK,ITEMP,ITEMP,ITEMP)
24736          CALL IGrColourN(IJUNK)
24737        ELSE
24738          CALL IGrColourN(2)
24739        ENDIF
24740      ELSE
24741        CALL IGrColourN(JCOL)
24742      ENDIF
24743#endif
24744      GOTO9000
24745C
24746C
24747C        ******************************************************
24748C        **  STEP 51--                                       **
24749C        **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
24750C        **  TO SET COLOR--                                  **
24751C        **  WRITE OUT A    71 TO 74     OP CODE             **
24752C        **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
24753C        **             MODELS 3600SX AND 3653SX             **
24754C        **             PAGES B-0 AND B-1                    **
24755C        **  USE CALCOMP LIBRARY ROUTINES                    **
24756C        ******************************************************
24757C
24758 5100 CONTINUE
24759C
24760      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)JCOL=2
24761      IF(JCOL.GE.2000 .AND. JCOL.LE.2999)JCOL=4
24762      IF(JCOL.GE.3000 .AND. JCOL.LE.3999)JCOL=3
24763C
24764      IF(ICASE.EQ.'BACK')GOTO9000
24765      IF(IZETCC.NE.JCOL)THEN
24766#ifdef HAVE_ZETA
24767        CALL NEWPEN(JCOL)
24768#endif
24769        IZETCC=JCOL
24770      ENDIF
24771      GOTO9000
24772C
24773C        ******************************************************
24774C        **  STEP 66--                                       **
24775C        **  TREAT THE SUN CASE                              **
24776C        ******************************************************
24777C
24778 6600 CONTINUE
24779C
24780      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)JCOL=1
24781      IF(JCOL.GE.2000 .AND. JCOL.LE.2999)JCOL=2
24782      IF(JCOL.GE.3000 .AND. JCOL.LE.3999)JCOL=3
24783C
24784      IF(ICASE.EQ.'BACK')THEN
24785C       BLACK(I.E. 'DARK')
24786        RD(1) = 0
24787        GN(1) = 0
24788        BE(1) = 0
24789C       RED
24790        RD(2) = 244
24791        GN(2) = 9
24792        BE(2) = 6
24793C       GREEN
24794        RD(3) = 50
24795        GN(3) = 198
24796        BE(3) = 12
24797C       BLUE
24798        RD(4) = 120
24799        GN(4) = 215
24800        BE(4) = 247
24801C       YELLOW
24802        RD(5) = 254
24803        GN(5) = 241
24804        BE(5) = 108
24805C       ORANGE
24806C       RD(6) = 245
24807C       GN(6) = 176
24808C       BE(6) = 33
24809C       BLACK
24810        RD(6) = 0
24811        GN(6) = 0
24812        BE(6) = 0
24813C       PURPLE
24814        RD(7) = 189
24815        GN(7) = 102
24816        BE(7) = 249
24817C       WHITE
24818        RD(8) = 255
24819        GN(8) = 255
24820        BE(8) = 255
24821        RED(1) = RD(JCOL+1)
24822        GRN(1) = GN(JCOL+1)
24823        BLE(1) = BE(JCOL+1)
24824        DO 6605 I =2,8
24825           RED(I) = RD(I)
24826           GRN(I) = GN(I)
24827           BLE(I) = BE(I)
24828 6605   CONTINUE
24829#ifdef HAVE_SUN
24830        CALL cfcotable(0,RED,GRN,BLE,8)
24831#endif
24832      ELSEIF(ICASE.EQ.'REGI')THEN
24833#ifdef HAVE_SUN
24834        CALL cfflcolor(JCOL)
24835#endif
24836      ELSEIF(ICASE.EQ.'TEXT')THEN
24837#ifdef HAVE_SUN
24838        CALL cftextcolor(JCOL)
24839#endif
24840      ELSE
24841#ifdef HAVE_SUN
24842        CALL cflncolor(JCOL)
24843#endif
24844      ENDIF
24845C
24846      GOTO9000
24847C
24848C        ******************************************************
24849C        **  STEP 81--                                       **
24850C        **  TREAT THE REGIS CASE                            **
24851C        **  ADD SUPPORT FOR COLOR (JANUARY, 1991).  SPECIFY **
24852C        **  THE COLOR BY HLS VALUE.  THESE VALUES ARE STORED**
24853C        **  IN AN ARRAY.  REGIS SUPPORTS 64 HLS COLORS (AT  **
24854C        **  LEAST ON THE VT-240, DON'T KNOW IF MORE RECENT  **
24855C        **  MODELS SUPPORT MORE).  THESE 64 COLORS ARE      **
24856C        **  FIXED (I.E., CAN'T REDEFINE AVAILABLE COLORS).  **
24857C        **  NOTE THAT REGIS ALLOWS 4 COLOR MAP LOCATIONS TO **
24858C        **  BE DEFINED.  WE USE LOCATION 0 FOR THE          **
24859C        **  BACKGROUND COLOR AND LOCATIONS 1 THRU 3 FOR THE **
24860C        **  FOREGROUND COLOR.  THE M1 COMMAND DEFINES THE   **
24861C        **  COLOR AND COMMAND W(I1) SPECIFIES WHICH COLOR   **
24862C        **  MAP.                                            **
24863C        ******************************************************
24864C
24865 8100 CONTINUE
24866      IF(IGCOLO.NE.'ON')GOTO9000
24867      IF(ICASE.EQ.'BACK')GOTO9000
24868C
24869      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)JCOL=47
24870      IF(JCOL.GE.2000 .AND. JCOL.LE.2999)JCOL=23
24871      IF(JCOL.GE.3000 .AND. JCOL.LE.3999)JCOL=4
24872C
24873      DO8115I=1,IREGMC
24874        IF(JCOL.EQ.IREGPM(I))THEN
24875          IMAP=I
24876          GOTO8116
24877        END IF
24878 8115 CONTINUE
24879      IMAP=IREGMC
24880 8116 CONTINUE
24881      ICSTR(1:27)='S(M  (AH   L   S   ))W(I  )'
24882      NCHTOT=2
24883      NCSTR=3
24884      CALL GRTRIN(IMAP,NCHTOT,ICSTR,NCSTR)
24885      NCSTR=24
24886      CALL GRTRIN(IMAP,NCHTOT,ICSTR,NCSTR)
24887      NCHTOT=3
24888      ITEMP=IRGHUE(JCOL)
24889      NCSTR=8
24890      CALL GRTRIN(ITEMP,NCHTOT,ICSTR,NCSTR)
24891      ITEMP=IRGLGT(JCOL)
24892      NCSTR=12
24893      CALL GRTRIN(ITEMP,NCHTOT,ICSTR,NCSTR)
24894      ITEMP=IRGSAT(JCOL)
24895      NCSTR=16
24896      CALL GRTRIN(ITEMP,NCHTOT,ICSTR,NCSTR)
24897      NCSTR=27
24898      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
24899      GOTO9000
24900C
24901C        ******************************************************
24902C        **  STEP 86--                                       **
24903C        **  TREAT THE POSTSCRIPT CASE                       **
24904C        **  INDEX BY THE USER, THE OTHERS ONLY BY INDEX     **
24905C        ******************************************************
24906C
24907C  AUGUST 1992.  UPDATED TO HANDLE COLORS CONSISTENTLY WITH OTHER
24908C  DEVICES.  POSTSCRIPT ALLOWS RGB VALUES TO BE SET DIRECTLY.  USE
24909C  COLOR DEFINITIONS PROVIDED IN "XLIB PROGRAMMERS MANUAL" FROM
24910C  O'REILLY.  ALSO, SUPPORT GRAY SCALE FOR BOTH COLOR AND BLACK AND
24911C  WHITE POSTSCRIPT.
24912C
24913 8600 CONTINUE
24914C
24915CCCCC IF(IGCOLO.NE.'ON')GOTO9000
24916      IF(ICASE.EQ.'BACK')GOTO9000
24917CCCCC GOTO8610
24918C
24919C8610 CONTINUE
24920CCCCC IF(JCOL.EQ.0)ICSTR(1:26)='0.   0.   0.   setrgbcolor'
24921CCCCC IF(JCOL.EQ.1)ICSTR(1:26)='1.   0.   0.   setrgbcolor'
24922CCCCC IF(JCOL.EQ.2)ICSTR(1:26)='0.   1.   0.   setrgbcolor'
24923CCCCC IF(JCOL.EQ.3)ICSTR(1:26)='1.   1.   0.   setrgbcolor'
24924CCCCC IF(JCOL.EQ.4)ICSTR(1:26)='0.   0.   1.   setrgbcolor'
24925CCCCC IF(JCOL.EQ.5)ICSTR(1:26)='1.   0.   1.   setrgbcolor'
24926CCCCC IF(JCOL.EQ.6)ICSTR(1:26)='0.   1.   1.   setrgbcolor'
24927CCCCC IF(JCOL.EQ.7)ICSTR(1:26)='1.   1.   1.   setrgbcolor'
24928CCCCC IF(JCOL.EQ.8)ICSTR(1:26)='1.   0.5  0.   setrgbcolor'
24929CCCCC IF(JCOL.EQ.9)ICSTR(1:26)='0.5  1.   0.   setrgbcolor'
24930CCCCC IF(JCOL.EQ.10)ICSTR(1:26)='0.   1.   0.5  setrgbcolor'
24931CCCCC IF(JCOL.EQ.11)ICSTR(1:26)='0.   0.5  1.   setrgbcolor'
24932CCCCC IF(JCOL.EQ.12)ICSTR(1:26)='0.5  0.   1.   setrgbcolor'
24933CCCCC IF(JCOL.EQ.13)ICSTR(1:26)='1.   0.   0.5  setrgbcolor'
24934CCCCC IF(JCOL.EQ.14)ICSTR(1:26)='0.33 0.33 0.33 setrgbcolor'
24935CCCCC IF(JCOL.EQ.15)ICSTR(1:26)='0.66 0.66 0.66 setrgbcolor'
24936CCCCC NCSTR=26
24937CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0)
24938      IF(JCOL.LT.0)THEN
24939CCCCC   MARCH 1993.  HANDLE BLACK AND WHITE DEVICES DIFFERENTLY THAN
24940CCCCC   COLOR DEVICES.
24941        IF(IGCOLO.EQ.'ON')THEN
24942          AVAL=REAL(JCOL)/100.
24943          AVAL=ABS(AVAL)
24944          IF(AVAL.LE.0.0)AVAL=0.0
24945          IF(AVAL.GE.1.0)AVAL=1.0
24946          NCSTR=0
24947          NCHTOT=7
24948          NCHDEC=5
24949          CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
24950          NCSTR=NCSTR+1
24951          ICSTR(NCSTR:NCSTR)=' '
24952          CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
24953          NCSTR=NCSTR+1
24954          ICSTR(NCSTR:NCSTR)=' '
24955          CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
24956          NCSTR=NCSTR+1
24957          ICSTR(NCSTR:NCSTR)=' '
24958          NCSTR=NCSTR+1
24959          NCSTR2=NCSTR+10
24960          ICSTR(NCSTR:NCSTR2)='setrgbcolor'
24961          NCSTR=NCSTR2
24962          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
24963CCCCC   MARCH 1993.  ADD FOLLOWING SECTION.
24964        ELSE
24965          AVAL=REAL(JCOL)/100.
24966          AVAL=ABS(AVAL)
24967          IF(AVAL.LE.0.0)AVAL=0.0
24968          IF(AVAL.GE.1.0)AVAL=1.0
24969          NCSTR=0
24970          NCHTOT=7
24971          NCHDEC=5
24972          CALL GRTRRE(AVAL,NCHTOT,NCHDEC,ICSTR,NCSTR)
24973          NCSTR=NCSTR+1
24974          ICSTR(NCSTR:NCSTR)=' '
24975          NCSTR=NCSTR+1
24976          NCSTR2=NCSTR+6
24977          ICSTR(NCSTR:NCSTR2)='setgray'
24978          NCSTR=NCSTR2
24979          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
24980        END IF
24981      ELSE
24982CCCCC   MARCH 1993.  FOR BLACK AND WHITE DEVICES, BE SURE TO RESET
24983CCCCC   GRAY SCALE.
24984CCCCC   IF(IGCOLO.NE.'ON')GOTO9000
24985        IF(IGCOLO.EQ.'ON')THEN
24986C
24987          ATEMP=255.0
24988          IF(JCOL.GE.1000 .AND. JCOL.LE.1999)THEN
24989            AVALR=REAL(JCOL - 1000)/ATEMP
24990            AVALG=0.0
24991            AVALB=0.0
24992          ELSEIF(JCOL.GE.2000 .AND. JCOL.LE.2999)THEN
24993            AVALR=0.0
24994            AVALG=REAL(JCOL - 2000)/ATEMP
24995            AVALB=0.0
24996          ELSEIF(JCOL.GE.3000 .AND. JCOL.LE.3999)THEN
24997            AVALR=0.0
24998            AVALG=0.0
24999            AVALB=REAL(JCOL - 3000)/ATEMP
25000          ELSE
25001            IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JCOL=1
25002            AVALR=REAL(IRED(JCOL))/ATEMP
25003            AVALG=REAL(IGREEN(JCOL))/ATEMP
25004            AVALB=REAL(IBLUE(JCOL))/ATEMP
25005          ENDIF
25006C
25007          NCSTR=0
25008          NCHTOT=7
25009          NCHDEC=5
25010          CALL GRTRRE(AVALR,NCHTOT,NCHDEC,ICSTR,NCSTR)
25011          NCSTR=NCSTR+1
25012          ICSTR(NCSTR:NCSTR)=' '
25013          CALL GRTRRE(AVALG,NCHTOT,NCHDEC,ICSTR,NCSTR)
25014          NCSTR=NCSTR+1
25015          ICSTR(NCSTR:NCSTR)=' '
25016          CALL GRTRRE(AVALB,NCHTOT,NCHDEC,ICSTR,NCSTR)
25017          NCSTR=NCSTR+1
25018          ICSTR(NCSTR:NCSTR)=' '
25019          NCSTR=NCSTR+1
25020          NCSTR2=NCSTR+10
25021          ICSTR(NCSTR:NCSTR2)='setrgbcolor'
25022          NCSTR=NCSTR2
25023          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
25024CCCCC     MARCH 1993.  ADD FOLLOWING SECTION.
25025        ELSE
25026          ICSTR(1:10)='0. setgray'
25027          NCSTR=10
25028          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
25029        ENDIF
25030      ENDIF
25031      GOTO9000
25032C
25033C        ******************************************************
25034C        **  STEP 91--                                       **
25035C        **  TREAT THE QUIC CASE                             **
25036C        ******************************************************
25037C
25038 9100 CONTINUE
25039      GOTO9000
25040C
25041C        ******************************************************
25042C        **  STEP 96--                                       **
25043C        **  TREAT THE X11     CASE                          **
25044C        ******************************************************
25045C
25046 9600 CONTINUE
25047#ifdef HAVE_X11
25048C
25049      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)JCOL=4
25050      IF(JCOL.GE.2000 .AND. JCOL.LE.2999)JCOL=2
25051      IF(JCOL.GE.3000 .AND. JCOL.LE.3999)JCOL=5
25052C
25053      IF(IX11OF.EQ.'OFF')GOTO9000
25054      CALL XFORE(JCOL)
25055#endif
25056      GOTO9000
25057C
25058C        *************************************************
25059C        **  STEP 100--                                 **
25060C        **  TREAT THE VGA VIA TURBO-C       CASE       **
25061C        **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
25062C        **             ENHANCEMENTS, PAGE 122.         **
25063C        **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
25064C        **             PAGE 309-310, 312-313.          **
25065C        *************************************************
25066C
2506710000 CONTINUE
25068C
25069      IF(ITCST.EQ.'CLOS')GOTO9000
25070CTURB CALL TCSECO(ICASE,ICOL)
25071      GOTO9000
25072C
25073C        ******************************************************
25074C        **  STEP 110--                                      **
25075C        **  TREAT THE GKS                DRIVER             **
25076C        ******************************************************
25077C
2507811000 CONTINUE
25079      GOTO9000
25080C
25081C       ******************************************************
25082C       **  STEP 120--                                      **
25083C       **  TREAT THE GD                     DRIVER         **
25084C       **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
25085C       **  1) JPEG                                         **
25086C       **  2) PNG                                          **
25087C       **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
25088C       **  NOTE: COLOR PASSED TO DRAWING ROUTINES          **
25089C       ******************************************************
25090C
2509112000 CONTINUE
25092C
25093      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)JCOL=3
25094      IF(JCOL.GE.2000 .AND. JCOL.LE.2999)JCOL=5
25095      IF(JCOL.GE.3000 .AND. JCOL.LE.3999)JCOL=4
25096C
25097#ifdef HAVE_GD
25098      CALL GDSECO(JCOL)
25099#endif
25100      GOTO9000
25101C
25102C         ******************************************************
25103C         **  STEP 130--                                      **
25104C         **  TREAT THE ABSOFT                 DRIVER         **
25105C         ******************************************************
25106C
2510713000 CONTINUE
25108C
25109      IFACT=1
25110      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)THEN
25111        IR=IFACT*(JCOL - 1000)
25112        IG=0
25113        IB=0
25114      ELSEIF(JCOL.GE.2000 .AND. JCOL.LE.2999)THEN
25115        IR=0
25116        IG=IFACT*(JCOL - 2000)
25117        IB=0
25118      ELSEIF(JCOL.GE.3000 .AND. JCOL.LE.3999)THEN
25119        IR=0
25120        IG=0
25121        IB=IFACT*(JCOL - 3000)
25122      ELSE
25123        IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JCOL=1
25124        IR=IFACT*IRED(JCOL)
25125        IG=IFACT*IGREEN(JCOL)
25126        IB=IFACT*IBLUE(JCOL)
25127      ENDIF
25128C
25129      ITEMP=1
25130#ifdef HAVE_ABSOFT
25131      CALL SetMyColor(ITEMP,IR,IG,IB)
25132#endif
25133      GOTO9000
25134C
25135C               ******************************************************
25136C               **  STEP 135--                                      **
25137C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
25138C               ******************************************************
25139C
25140C  NOTE: COLOR CAN SET EITHER FROM COLOR MAP TABLE OR BY SETTING
25141C        RGB VALUES DIRECTLY.  FOR INITIAL IMPLEMENTATION, WE WILL
25142C        USE THE COLORMAP METHOD, BUT INCLUDE CODE DIRECT METHOD
25143C        IN CASE THAT PROVES MORE EFFECTIVE.
25144C
2514513500 CONTINUE
25146C
25147COLD  CALL aqtTakeColorFromColormapEntry(JCOL)
25148CCCCC AR=REAL(IRED(JCOL))/255.
25149CCCCC AG=REAL(IGREEN(JCOL))/255.
25150CCCCC AB=REAL(IBLUE(JCOL))/255.
25151CCCCC CALL aqtSetColor(AR,AG,AB)
25152#ifdef HAVE_AQUA
25153      CALL aqseco(JCOL)
25154#endif
25155      GOTO9000
25156C
25157C
25158C               ******************************************************
25159C               **  STEP 150--                                      **
25160C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
25161C               ******************************************************
25162C
2516315000 CONTINUE
25164      IF(ILATCO.EQ.'ON')THEN
25165        IF(JCOL.GE.1000 .AND. JCOL.LE.1999)ICOL='RED'
25166        IF(JCOL.GE.2000 .AND. JCOL.LE.2999)ICOL='GREE'
25167        IF(JCOL.GE.3000 .AND. JCOL.LE.3999)ICOL='BLUE'
25168        ICSTR(1:1)=IBASLC
25169        ICSTR(2:12)='color{    }'
25170        ICSTR(8:11)=ICOL(1:4)
25171        NCSTR=12
25172        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
25173        GOTO9000
25174      ENDIF
25175C
25176C               ******************************************************
25177C               **  STEP 160--                                      **
25178C               **  TREAT THE SCALABLE VECTOR GRAPHICS       DRIVER **
25179C               ******************************************************
25180C
2518116000 CONTINUE
25182      GOTO9000
25183C
25184C               ******************************************************
25185C               **  STEP 170--                                      **
25186C               **  TREAT THE CAIRO                          DRIVER **
25187C               ******************************************************
25188C
2518917000 CONTINUE
25190      ATEMP=255.0
25191      IF(JCOL.GE.1000 .AND. JCOL.LE.1999)THEN
25192        ARED=REAL(JCOL - 1000)/ATEMP
25193        AGREEN=0.0
25194        ABLUE=0.0
25195      ELSEIF(JCOL.GE.2000 .AND. JCOL.LE.2999)THEN
25196        ARED=0.0
25197        AGREEN=REAL(JCOL - 2000)/ATEMP
25198        ABLUE=0.0
25199      ELSEIF(JCOL.GE.3000 .AND. JCOL.LE.3999)THEN
25200        ARED=0.0
25201        AGREEN=0.0
25202        ABLUE=REAL(JCOL - 3000)/ATEMP
25203      ELSEIF(JCOL.LT.0 .AND. JCOL.GE.-100)THEN
25204        ARED=REAL(ABS(JCOL))/100.
25205        AGREEN=ARED
25206        ABLUE=ARED
25207      ELSE
25208        IF(JCOL.LT.1 .OR. JCOL.GT.MAXCLR)JCOL=1
25209        ARED=REAL(IRED(JCOL))/ATEMP
25210        AGREEN=REAL(IGREEN(JCOL))/ATEMP
25211        ABLUE=REAL(IBLUE(JCOL))/ATEMP
25212      ENDIF
25213C
25214      IF(ICASE.EQ.'BACK')GOTO9000
25215      IVAL2=1
25216      IF(IGUNIT.EQ.IPL1NU)IVAL2=2
25217      IF(IGUNIT.EQ.IPL2NU)IVAL2=3
25218#ifdef HAVE_CAIRO
25219      CALL CASECO(IVAL2,ARED,AGREEN,ABLUE)
25220#endif
25221      GOTO9000
25222C
25223C               ******************************************************
25224C               **  STEP 180--                                      **
25225C               **  TREAT THE WMF                            DRIVER **
25226C               ******************************************************
25227C
2522818000 CONTINUE
25229      GOTO9000
25230C
25231C               ******************************************************
25232C               **  STEP 190--                                      **
25233C               **  TREAT THE D3                             DRIVER **
25234C               ******************************************************
25235C
2523619000 CONTINUE
25237      GOTO9000
25238C
25239C               *****************
25240C               **  STEP 90--  **
25241C               **  EXIT       **
25242C               *****************
25243C
25244 9000 CONTINUE
25245      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SECO')THEN
25246        WRITE(ICOUT,999)
25247        CALL DPWRST('XXX','BUG ')
25248        WRITE(ICOUT,9011)
25249 9011   FORMAT('***** AT THE END       OF GRSECO--')
25250        CALL DPWRST('XXX','BUG ')
25251        WRITE(ICOUT,9013)ICOL,ICOL2,JCOL,JCOL2
25252 9013   FORMAT('ICOL,ICOL2,JCOL,JCOL2 = ',2(A4,2X),2I8)
25253        CALL DPWRST('XXX','BUG ')
25254        WRITE(ICOUT,9017)IX,ITEN,IUNIT,NCSTR,IERRG4
25255 9017   FORMAT('IX,ITEN,IUNIT,NCSTR,IERRG4 = ',4I8,2X,A4)
25256        CALL DPWRST('XXX','BUG ')
25257        IF(NCSTR.GT.0)THEN
25258          DO9025I=1,NCSTR
25259            CALL DPCOAN(ICSTR(I:I),IASCNE)
25260            WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
25261 9026       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
25262            CALL DPWRST('XXX','BUG ')
25263 9025     CONTINUE
25264        ENDIF
25265      ENDIF
25266C
25267      RETURN
25268      END
25269      SUBROUTINE GRSEDI(ICASE,IDIR,ANGLE,JDIR,ANGLE2)
25270C
25271C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, SET A DIRECTION
25272C              ON A SPECIFIC GRAPHICS DEVICE
25273C
25274C     WRITTEN BY--JAMES J. FILLIBEN
25275C                 STATISTICAL ENGINEERING DIVISION
25276C                 INFORMATION TECHNOLOGY LABORATORY
25277C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
25278C                 GAITHERSBURG, MD 20899-8980
25279C                 PHONE--301-975-2855
25280C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
25281C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
25282C     LANGUAGE--ANSI FORTRAN (1977)
25283C     VERSION NUMBER--83.6
25284C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
25285C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
25286C                                      DRIVER OBSOLETE
25287C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
25288C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
25289C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
25290C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
25291C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
25292C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
25293C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
25294C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
25295C                                      DRIVER OBSOLETE
25296C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
25297C                                      OLD STYLE CALCOMP
25298C                                      DRIVER OBSOLETE
25299C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
25300C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
25301C                                      USE BILL MITCHELLS OPENGL
25302C                                      BINDING FOR FORTRAN
25303C     UPDATED         --OCTOBER  1996. GKS (ALAN)
25304C                                      CODED, NOT TESTED
25305C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
25306C                                      PLACEHOLDER FOR NOW
25307C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
25308C                                      PLACEHOLDER FOR NOW
25309C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
25310C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
25311C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
25312C     UPDATED         --JUNE     2000. MACINTOSH
25313C                                      PLACEHOLDER FOR NOW
25314C     UPDATED         --JUNE     2000. PC PRINTER
25315C                                      PLACEHOLDER FOR NOW
25316C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
25317C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
25318C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
25319C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
25320C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
25321C
25322C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
25323C
25324      CHARACTER*4 ICASE
25325      CHARACTER*4 IDIR
25326C
25327      CHARACTER*130 ICSTR
25328      CHARACTER*4 ISUBN0
25329C
25330C-----COMMON----------------------------------------------------------
25331C
25332      INCLUDE 'DPCOGR.INC'
25333      INCLUDE 'DPCONP.INC'
25334      INCLUDE 'DPCOBE.INC'
25335      INCLUDE 'DPCOST.INC'
25336      INCLUDE 'DPCOP2.INC'
25337C
25338C-----START POINT-----------------------------------------------------
25339C
25340      ISUBN0='SEDI'
25341      IERRG4='NO'
25342C
25343      NCSTR=(-999)
25344C
25345      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SEDI')THEN
25346        WRITE(ICOUT,999)
25347  999   FORMAT(1X)
25348        CALL DPWRST('XXX','BUG ')
25349        WRITE(ICOUT,51)
25350   51   FORMAT('***** AT THE BEGINNING OF GRSEDI--')
25351        CALL DPWRST('XXX','BUG ')
25352        WRITE(ICOUT,53)ICASE,IDIR,JDIR,ANGLE,ANGLE2
25353   53   FORMAT('ICASE,IDIR,JDIR,ANGLE,ANGLE2 = ',2(A4,2X),I8,2G15.7)
25354        CALL DPWRST('XXX','BUG ')
25355        WRITE(ICOUT,55)IMANUF,IMODEL,IBUGG4,IGUNIT
25356   55   FORMAT('IMANUF,IMODEL,IBUGG4,IGUNIT = ',3(A4,2X),I8)
25357        CALL DPWRST('XXX','BUG ')
25358      ENDIF
25359C
25360C
25361C               ********************************************
25362C               **  STEP 1--                              **
25363C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
25364C               **  AND THE MODEL                         **
25365C               ********************************************
25366C
25367      IF(IMANUF.EQ.'QWIN')THEN
25368        GOTO4700
25369      ELSEIF(IMANUF.EQ.'POST')THEN
25370        GOTO8600
25371      ELSEIF(IMANUF.EQ.'X11 ')THEN
25372        GOTO9600
25373      ELSEIF(IMANUF.EQ.'AQUA')THEN
25374        GOTO13500
25375      ELSEIF(IMANUF.EQ.'GENE')THEN
25376        IF(IMODEL.EQ.'CODE')GOTO3200
25377        IF(IMODEL.EQ.'CGM')GOTO3300
25378        IF(IMODEL.EQ.'CGMB')GOTO3400
25379        GOTO3100
25380      ELSEIF(IMANUF.EQ.'SVG ')THEN
25381        GOTO16000
25382      ELSEIF(IMANUF.EQ.'GD  ')THEN
25383        GOTO12000
25384      ELSEIF(IMANUF.EQ.'LATE')THEN
25385        GOTO15000
25386      ELSEIF(IMANUF.EQ.'CAIR')THEN
25387        GOTO17000
25388      ELSEIF(IMANUF.EQ.'D3  ')THEN
25389        GOTO19000
25390      ELSEIF(IMANUF.EQ.'WMF ')THEN
25391        GOTO18000
25392      ELSEIF(IMANUF.EQ.'OPGL')THEN
25393        GOTO4800
25394      ELSEIF(IMANUF.EQ.'TEKT')THEN
25395        GOTO1100
25396      ELSEIF(IMANUF.EQ.'HP')THEN
25397        IF(IMODEL.EQ.'7221')GOTO2100
25398        IF(IMODEL.EQ.'2622')GOTO2300
25399        IF(IMODEL.EQ.'2623')GOTO2300
25400        IF(IMODEL.EQ.'2627')GOTO2300
25401        IF(IMODEL.EQ.'2647')GOTO2300
25402        GOTO2200
25403      ELSEIF(IMANUF.EQ.'LIBP')THEN
25404        GOTO2600
25405      ELSEIF(IMANUF.EQ.'REGI')THEN
25406        GOTO8100
25407      ELSEIF(IMANUF.EQ.'GKS ')THEN
25408        GOTO11000
25409      ELSEIF(IMANUF.EQ.'LAHE')THEN
25410        IF(IMODEL.EQ.'INTE')GOTO4900
25411        IF(IMODEL.EQ.'WINT')GOTO4950
25412        GOTO4600
25413      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
25414        GOTO13000
25415      ELSEIF(IMANUF.EQ.'QUIC')THEN
25416        GOTO9100
25417      ELSEIF(IMANUF.EQ.'CALC')THEN
25418        GOTO4100
25419      ELSEIF(IMANUF.EQ.'ZETA')THEN
25420        GOTO5100
25421      ELSEIF(IMANUF.EQ.'TURB')THEN
25422        GOTO10000
25423      ELSEIF(IMANUF.EQ.'SUN ')THEN
25424        GOTO6600
25425      ENDIF
25426      GOTO9000
25427C
25428C               ******************************************************
25429C               **  STEP 11--                                       **
25430C               **  TREAT THE TEKTRONIX CASE                        **
25431C               **  REFERENCE--XXX                                  **
25432C               ******************************************************
25433C
25434 1100 CONTINUE
25435      GOTO9000
25436C
25437C               ******************************************************
25438C               **  STEP 21--                                       **
25439C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
25440C               **  (MULTI-COLOR PENPLOTTER)                        **
25441C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
25442C               **             OPERATING AND PROGRAMMING MANUAL,    **
25443C               **             PAGE XX.                             **
25444C               ******************************************************
25445C
25446 2100 CONTINUE
25447      GOTO9000
25448C
25449C               ******************************************************
25450C               **  STEP 22--                                       **
25451C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
25452C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
25453C               **  (MULTI-COLOR PENPLOTTERS)                       **
25454C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
25455C               **             OPERATING AND PROGRAMMING MANUAL,    **
25456C               **             PAGE XX, XXX.                        **
25457C               ******************************************************
25458C
25459 2200 CONTINUE
25460      GOTO9000
25461C
25462C               **********************************************************
25463C               **  STEP 23--                                           **
25464C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
25465C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
25466C               **  (MONOCHROME DISPLAY TERMINALS)                      **
25467C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
25468C               **             REFERENCE MANUAL,                        **
25469C               **             PAGE 10-19, XXX.                         **
25470C               **********************************************************
25471C
25472 2300 CONTINUE
25473      ICSTR(1:1)=IESCC
25474      ICSTR(2:6)='*m1nZ'
25475      NCSTR=6
25476      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
25477      GOTO9000
25478C
25479C               ******************************************************
25480C               **  STEP 26--                                       **
25481C               **  TREAT THE UNIX LIBPLOT  CASE                    **
25482C               ******************************************************
25483C
25484 2600 CONTINUE
25485      GOTO9000
25486C
25487C               ******************************************************
25488C               **  STEP 31--                                       **
25489C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
25490C               ******************************************************
25491C
25492 3100 CONTINUE
25493      ICSTR(1:14)='SET DIRECTION '
25494      ICSTR(15:18)=IDIR
25495      NCSTR=18
25496      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
25497      ICSTR(1:10)='SET ANGLE '
25498      NCSTR=10
25499      X=ANGLE
25500      NCHTOT=10
25501      NCHDEC=5
25502      CALL GRTRRE(X,NCHTOT,NCHDEC,ICSTR,NCSTR)
25503      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
25504      GOTO9000
25505C
25506C               ***************************************************************
25507C               **  STEP 32--                                                **
25508C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
25509C               ***************************************************************
25510C
25511 3200 CONTINUE
25512      ICSTR(1:5)='SEDI '
25513      ICSTR(6:9)=IDIR
25514      NCSTR=9
25515      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
25516      ICSTR(1:5)='SEAN '
25517      NCSTR=5
25518      X=ANGLE
25519      NCHTOT=10
25520      NCHDEC=5
25521      CALL GRTRRE(X,NCHTOT,NCHDEC,ICSTR,NCSTR)
25522      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
25523      GOTO9000
25524C
25525C               ******************************************************
25526C               **  STEP 33--                                       **
25527C               **  TREAT THE CGM CASE                              **
25528C               ******************************************************
25529C
25530 3300 CONTINUE
25531      IF(IDIR.EQ.'VERT')THEN
25532        IF(IJUSSW.EQ.'ON')THEN
25533          ICSTR(1:14)='TEXTPATH DOWN;'
25534          NCSTR=14
25535        ELSE
25536          ICSTR(1:15)='TEXTPATH RIGHT;'
25537          NCSTR=15
25538        ENDIF
25539        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
25540      ELSE
25541        ICSTR(1:15)='TEXTPATH RIGHT;'
25542        NCSTR=15
25543      ENDIF
25544      GOTO9000
25545C
25546C               ***************************************************
25547C               **  STEP 34--                                    **
25548C               **  TREAT THE CGM (BINARY)                 CASE  **
25549C               ***************************************************
25550C
25551 3400 CONTINUE
25552      GOTO9000
25553C
25554C               ******************************************************
25555C               **  STEP 41--                                       **
25556C               **  TREAT THE CALCOMP XXXXXX CASE                   **
25557C               **  (NOT DONE)                                      **
25558C               **  REFERENCE--XX                                   **
25559C               **             XX                                   **
25560C               **             PAGES XX AND XX                      **
25561C               ******************************************************
25562C
25563 4100 CONTINUE
25564      GOTO9000
25565C
25566C               ******************************************************
25567C               **  STEP 46--                                       **
25568C               **  TREAT THE LAHEY   XXXXXX CASE                   **
25569C               **  REFERENCE--Programmer's Reference, Revision C   **
25570C               **             Lahey Computer Systems, January, 1992**
25571C               **             PAGES 51 THRU 65                     **
25572C               ******************************************************
25573C
25574 4600 CONTINUE
25575      GOTO9000
25576C
25577C               ******************************************************
25578C               **  STEP 47--                                       **
25579C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
25580C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
25581C               ******************************************************
25582C
25583 4700 CONTINUE
25584      GOTO9000
25585C
25586C               ******************************************************
25587C               **  STEP 48--                                       **
25588C               **  TREAT THE OPEN-GL DRIVER                        **
25589C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
25590C               ******************************************************
25591C
25592 4800 CONTINUE
25593      GOTO9000
25594C
25595C               ******************************************************
25596C               **  STEP 49--                                       **
25597C               **  TREAT THE LAHEY INTERACTOR CASE                 **
25598C               ******************************************************
25599C
25600 4900 CONTINUE
25601      GOTO9000
25602C
25603C               ******************************************************
25604C               **  STEP 49B-                                       **
25605C               **  TREAT THE LAHEY WINTERACTOR CASE                **
25606C               ******************************************************
25607C
25608 4950 CONTINUE
25609      GOTO9000
25610C
25611C
25612C               ******************************************************
25613C               **  STEP 51--                                       **
25614C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
25615C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
25616C               **             MODELS 3600SX AND 3653SX             **
25617C               **             PAGES B-0 AND B-1                    **
25618C               ******************************************************
25619C
25620 5100 CONTINUE
25621      GOTO9000
25622C
25623C               ******************************************************
25624C               **  STEP 66--                                       **
25625C               **  TREAT THE SUN CASE                              **
25626C               ******************************************************
25627C
25628 6600 CONTINUE
25629      GOTO9000
25630C
25631C               ******************************************************
25632C               **  STEP 81--                                       **
25633C               **  TREAT THE REGIS CASE                            **
25634C               ******************************************************
25635C
25636 8100 CONTINUE
25637      GOTO9000
25638C
25639C               ******************************************************
25640C               **  STEP 86--                                       **
25641C               **  TREAT THE POSTSCRIPT CASE                       **
25642C               ******************************************************
25643C
25644 8600 CONTINUE
25645      GOTO9000
25646C
25647C               ******************************************************
25648C               **  STEP 91--                                       **
25649C               **  TREAT THE QUIC CASE                             **
25650C               ******************************************************
25651C
25652 9100 CONTINUE
25653      GOTO9000
25654C
25655C               ******************************************************
25656C               **  STEP 96--                                       **
25657C               **  TREAT THE X11     CASE                          **
25658C               ******************************************************
25659C
25660 9600 CONTINUE
25661      GOTO9000
25662C
25663C               *************************************************
25664C               **  STEP 100--                                 **
25665C               **  TREAT THE VGA VIA TURBO-C       CASE       **
25666C               **  DONE VIA settextstyle in GRWRTH & GRWRTV   **
25667C               *************************************************
25668C
2566910000 CONTINUE
25670CTURB CALL TCSEDI(IDIR)
25671      GOTO9000
25672C
25673C               ******************************************************
25674C               **  STEP 110--                                      **
25675C               **  TREAT THE GKS                DRIVER             **
25676C               ******************************************************
25677C
2567811000 CONTINUE
25679      GOTO9000
25680C
25681C               ******************************************************
25682C               **  STEP 120--                                      **
25683C               **  TREAT THE GD                     DRIVER         **
25684C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
25685C               **  1) JPEG                                         **
25686C               **  2) PNG                                          **
25687C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
25688C               ******************************************************
25689C
2569012000 CONTINUE
25691      GOTO9000
25692C
25693C               ******************************************************
25694C               **  STEP 130--                                      **
25695C               **  TREAT THE ABSOFT                 DRIVER         **
25696C               ******************************************************
25697C
2569813000 CONTINUE
25699      GOTO9000
25700C
25701C               ******************************************************
25702C               **  STEP 135--                                      **
25703C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
25704C               ******************************************************
25705C
2570613500 CONTINUE
25707      GOTO9000
25708C
25709C               ******************************************************
25710C               **  STEP 150--                                      **
25711C               **  TREAT THE LATEX (EEPIC)                  DRIVER **
25712C               ******************************************************
25713C
2571415000 CONTINUE
25715      GOTO9000
25716C
25717C               ******************************************************
25718C               **  STEP 160--                                      **
25719C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
25720C               ******************************************************
25721C
2572216000 CONTINUE
25723      GOTO9000
25724C
25725C               ******************************************************
25726C               **  STEP 170--                                      **
25727C               **  TREAT THE CAIRO                          DRIVER **
25728C               ******************************************************
25729C
2573017000 CONTINUE
25731      GOTO9000
25732C
25733C               ******************************************************
25734C               **  STEP 180--                                      **
25735C               **  TREAT THE WMF                            DRIVER **
25736C               ******************************************************
25737C
2573818000 CONTINUE
25739      GOTO9000
25740C
25741C               ******************************************************
25742C               **  STEP 190--                                      **
25743C               **  TREAT THE D3                             DRIVER **
25744C               ******************************************************
25745C
2574619000 CONTINUE
25747      GOTO9000
25748C
25749C               *****************
25750C               **  STEP 90--  **
25751C               **  EXIT       **
25752C               *****************
25753C
25754 9000 CONTINUE
25755      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SEDI')THEN
25756        WRITE(ICOUT,999)
25757        CALL DPWRST('XXX','BUG ')
25758        WRITE(ICOUT,9011)
25759 9011   FORMAT('***** AT THE END       OF GRSEDI--')
25760        CALL DPWRST('XXX','BUG ')
25761        WRITE(ICOUT,9017)ANGLE,X,NCHTOT,NCHDEC,NCSTR
25762 9017   FORMAT('ANGLE,X,NCHTOT,NCHDEC,NCSTR = ',2G15.7,3I8)
25763        CALL DPWRST('XXX','BUG ')
25764        IF(NCSTR.GT.0)THEN
25765          DO9025I=1,NCSTR
25766            CALL DPCOAN(ICSTR(I:I),IASCNE)
25767            WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
25768 9026       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
25769            CALL DPWRST('XXX','BUG ')
25770 9025     CONTINUE
25771        ENDIF
25772        WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
25773 9029   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
25774        CALL DPWRST('XXX','BUG ')
25775      ENDIF
25776C
25777      RETURN
25778      END
25779      SUBROUTINE GRSEFI(ICASE,IFILLT,JFILLT)
25780C
25781C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, SET A FILL
25782C              SPECIFICATION (ON/OFF) ON A SPECIFIC GRAPHICS DEVICE
25783C
25784C     WRITTEN BY--JAMES J. FILLIBEN
25785C                 STATISTICAL ENGINEERING DIVISION
25786C                 INFORMATION TECHNOLOGY LABORATORY
25787C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
25788C                 GAITHERSBURG, MD 20899-8980
25789C                 PHONE--301-975-2855
25790C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
25791C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
25792C     LANGUAGE--ANSI FORTRAN (1977)
25793C     VERSION NUMBER--83.6
25794C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
25795C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
25796C                                      DRIVER OBSOLETE
25797C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
25798C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
25799C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
25800C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
25801C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
25802C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
25803C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
25804C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
25805C                                      DRIVER OBSOLETE
25806C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
25807C                                      OLD STYLE CALCOMP
25808C                                      DRIVER OBSOLETE
25809C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
25810C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
25811C                                      USE BILL MITCHELLS OPENGL
25812C                                      BINDING FOR FORTRAN
25813C     UPDATED         --OCTOBER  1996. GKS (ALAN)
25814C                                      CODED, NOT TESTED
25815C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
25816C                                      PLACEHOLDER FOR NOW
25817C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
25818C                                      PLACEHOLDER FOR NOW
25819C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
25820C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
25821C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
25822C     UPDATED         --JUNE     2000. MACINTOSH
25823C                                      PLACEHOLDER FOR NOW
25824C     UPDATED         --JUNE     2000. PC PRINTER
25825C                                      PLACEHOLDER FOR NOW
25826C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
25827C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
25828C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
25829C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
25830C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
25831C
25832C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
25833C
25834      CHARACTER*4 ICASE
25835      CHARACTER*4 IFILLT
25836C
25837      CHARACTER*130 ICSTR
25838      CHARACTER*4 ISUBN0
25839C
25840C-----COMMON----------------------------------------------------------
25841C
25842      INCLUDE 'DPCOGR.INC'
25843      INCLUDE 'DPCONP.INC'
25844      INCLUDE 'DPCOBE.INC'
25845      INCLUDE 'DPCOP2.INC'
25846C
25847C-----START POINT-----------------------------------------------------
25848C
25849      ISUBN0='SEFI'
25850      IERRG4='NO'
25851C
25852      NCSTR=(-999)
25853C
25854      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SEFI')THEN
25855        WRITE(ICOUT,999)
25856  999   FORMAT(1X)
25857        CALL DPWRST('XXX','BUG ')
25858        WRITE(ICOUT,51)
25859   51   FORMAT('***** AT THE BEGINNING OF GRSEFI--')
25860        CALL DPWRST('XXX','BUG ')
25861        WRITE(ICOUT,52)ICASE,IFILLT,IMANUF,IMODEL,IBUGG4
25862   52   FORMAT('ICASE,IFILLT,IMANUF,IMODEL,IBUGG4 = ',4(A4,2X),A4)
25863        CALL DPWRST('XXX','BUG ')
25864      ENDIF
25865C
25866C               ********************************************
25867C               **  STEP 1--                              **
25868C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
25869C               **  AND THE MODEL                         **
25870C               ********************************************
25871C
25872      IF(IMANUF.EQ.'QWIN')THEN
25873        GOTO4700
25874      ELSEIF(IMANUF.EQ.'POST')THEN
25875        GOTO8600
25876      ELSEIF(IMANUF.EQ.'X11 ')THEN
25877        GOTO9600
25878      ELSEIF(IMANUF.EQ.'AQUA')THEN
25879        GOTO13500
25880      ELSEIF(IMANUF.EQ.'GENE')THEN
25881        IF(IMODEL.EQ.'CODE')GOTO3200
25882        IF(IMODEL.EQ.'CGM')GOTO3300
25883        IF(IMODEL.EQ.'CGMB')GOTO3400
25884        GOTO3100
25885      ELSEIF(IMANUF.EQ.'SVG ')THEN
25886        GOTO16000
25887      ELSEIF(IMANUF.EQ.'GD  ')THEN
25888        GOTO12000
25889      ELSEIF(IMANUF.EQ.'LATE')THEN
25890        GOTO15000
25891      ELSEIF(IMANUF.EQ.'CAIR')THEN
25892        GOTO17000
25893      ELSEIF(IMANUF.EQ.'D3  ')THEN
25894        GOTO19000
25895      ELSEIF(IMANUF.EQ.'WMF ')THEN
25896        GOTO18000
25897      ELSEIF(IMANUF.EQ.'OPGL')THEN
25898        GOTO4800
25899      ELSEIF(IMANUF.EQ.'TEKT')THEN
25900        IF(IMODEL.EQ.'4027')GOTO1200
25901        GOTO1100
25902      ELSEIF(IMANUF.EQ.'HP')THEN
25903        GOTO2100
25904      ELSEIF(IMANUF.EQ.'LIBP')THEN
25905        GOTO2600
25906      ELSEIF(IMANUF.EQ.'REGI')THEN
25907        GOTO8100
25908      ELSEIF(IMANUF.EQ.'GKS ')THEN
25909        GOTO11000
25910      ELSEIF(IMANUF.EQ.'LAHE')THEN
25911        IF(IMODEL.EQ.'INTE')GOTO4900
25912        IF(IMODEL.EQ.'WINT')GOTO4950
25913        GOTO4600
25914      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
25915        GOTO13000
25916      ELSEIF(IMANUF.EQ.'QUIC')THEN
25917        GOTO9100
25918      ELSEIF(IMANUF.EQ.'CALC')THEN
25919        GOTO4100
25920      ELSEIF(IMANUF.EQ.'ZETA')THEN
25921        GOTO5100
25922      ELSEIF(IMANUF.EQ.'TURB')THEN
25923        GOTO10000
25924      ELSEIF(IMANUF.EQ.'SUN ')THEN
25925        GOTO6600
25926      ENDIF
25927      GOTO9000
25928C
25929C               ******************************************************
25930C               **  STEP 11--                                       **
25931C               **  TREAT THE TEKTRONIX (ALL NON-4027 DEVICES)      **
25932C               **  (A PENPLOTTER).                                 **
25933C               **  REFERENCE--XXX                                  **
25934C               ******************************************************
25935C
25936 1100 CONTINUE
25937      GOTO9000
25938C
25939C               **************************************************************
25940C               **  STEP 12--                                               **
25941C               **  TREAT THE TEKTRONIX 4027 CASE                           **
25942C               **  (COLOR RASTER DEVICES).                                 **
25943C               **  REFERENCE--XXX                                          **
25944C               **************************************************************
25945C
25946 1200 CONTINUE
25947      IF(ICASE.EQ.'TEXT')THEN
25948        ICSTR(1:6)='!ATT C'
25949        IX=JFILLT+48
25950        CALL DPCONA(IX,ICSTR(7:7))
25951        ICSTR(8:8)=';'
25952        NCSTR=8
25953        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
25954      ENDIF
25955      GOTO9000
25956C               ******************************************************
25957C               **  STEP 21--                                       **
25958C               **  TREAT THE HP CASES                              **
25959C               ******************************************************
25960C
25961 2100 CONTINUE
25962      GOTO9000
25963C
25964C               ******************************************************
25965C               **  STEP 26--                                       **
25966C               **  TREAT THE UNIX LIBPLOT  CASE                    **
25967C               ******************************************************
25968C
25969 2600 CONTINUE
25970      GOTO9000
25971C
25972C               ***************************************************
25973C               **  STEP 31--                                    **
25974C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE  **
25975C               ***************************************************
25976C
25977 3100 CONTINUE
25978      ICSTR(1:9)='SET FILL '
25979      ICSTR(10:13)=IFILLT
25980      NCSTR=13
25981      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
25982      GOTO9000
25983C
25984C               ***************************************************************
25985C               **  STEP 32--                                                **
25986C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
25987C               ***************************************************************
25988C
25989 3200 CONTINUE
25990      ICSTR(1:5)='SEFI '
25991      ICSTR(6:9)=IFILLT
25992      NCSTR=9
25993      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
25994      GOTO9000
25995C
25996C               ******************************************************
25997C               **  STEP 33--                                       **
25998C               **  TREAT THE CGM CASE                              **
25999C               ******************************************************
26000C
26001 3300 CONTINUE
26002      GOTO9000
26003C
26004C               ***************************************************
26005C               **  STEP 34--                                    **
26006C               **  TREAT THE CGM (BINARY)                 CASE  **
26007C               ***************************************************
26008C
26009 3400 CONTINUE
26010      GOTO9000
26011C
26012C               ******************************************************
26013C               **  STEP 41--                                       **
26014C               **  TREAT THE CALCOMP XXXXXX CASE                   **
26015C               **  TO SET FILL--                                   **
26016C               **  WRITE OUT AN XXXXXXXXXX                         **
26017C               **  (NOT DONE)                                      **
26018C               **  REFERENCE--XX                                   **
26019C               **             XX                                   **
26020C               **             PAGES XX AND XX                      **
26021C               ******************************************************
26022C
26023 4100 CONTINUE
26024      GOTO9000
26025C
26026C               ******************************************************
26027C               **  STEP 46--                                       **
26028C               **  TREAT THE LAHEY   XXXXXX CASE                   **
26029C               **  REFERENCE--Programmer's Reference, Revision C   **
26030C               **             Lahey Computer Systems, January, 1992**
26031C               **             PAGES 51 THRU 65                     **
26032C               ******************************************************
26033C
26034 4600 CONTINUE
26035      GOTO9000
26036C
26037C               ******************************************************
26038C               **  STEP 47--                                       **
26039C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
26040C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
26041C               ******************************************************
26042C
26043 4700 CONTINUE
26044      GOTO9000
26045C
26046C               ******************************************************
26047C               **  STEP 48--                                       **
26048C               **  TREAT THE OPEN-GL DRIVER                        **
26049C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
26050C               ******************************************************
26051C
26052 4800 CONTINUE
26053      GOTO9000
26054C
26055C               ******************************************************
26056C               **  STEP 49--                                       **
26057C               **  TREAT THE LAHEY INTERACTOR CASE                 **
26058C               ******************************************************
26059C
26060 4900 CONTINUE
26061      GOTO9000
26062C
26063C               ******************************************************
26064C               **  STEP 49B-                                       **
26065C               **  TREAT THE LAHEY WINTERACTOR CASE                **
26066C               ******************************************************
26067C
26068 4950 CONTINUE
26069      GOTO9000
26070C
26071C
26072C               ******************************************************
26073C               **  STEP 51--                                       **
26074C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
26075C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
26076C               **             MODELS 3600SX AND 3653SX             **
26077C               **             PAGES B-0 AND B-1                    **
26078C               ******************************************************
26079C
26080 5100 CONTINUE
26081      GOTO9000
26082C
26083C               ******************************************************
26084C               **  STEP 66--                                       **
26085C               **  TREAT THE SUN CASE                              **
26086C               ******************************************************
26087C
26088 6600 CONTINUE
26089      GOTO9000
26090C
26091C               ******************************************************
26092C               **  STEP 81--                                       **
26093C               **  TREAT THE REGIS CASE                            **
26094C               ******************************************************
26095C
26096 8100 CONTINUE
26097      GOTO9000
26098C
26099C               ******************************************************
26100C               **  STEP 86--                                       **
26101C               **  TREAT THE POSTSCRIPT CASE                       **
26102C               ******************************************************
26103C
26104 8600 CONTINUE
26105      GOTO9000
26106C
26107C               ******************************************************
26108C               **  STEP 91--                                       **
26109C               **  TREAT THE QUIC CASE                             **
26110C               ******************************************************
26111C
26112 9100 CONTINUE
26113      GOTO9000
26114C
26115C               ******************************************************
26116C               **  STEP 96--                                       **
26117C               **  TREAT THE X11     CASE                          **
26118C               ******************************************************
26119C
26120 9600 CONTINUE
26121      GOTO9000
26122C
26123C               *************************************************
26124C               **  STEP 100--                                 **
26125C               **  TREAT THE VGA VIA TURBO-C       CASE       **
26126C               *************************************************
26127C
2612810000 CONTINUE
26129CTURB CALL TCSEFI(IFILLT)
26130      GOTO9000
26131C
26132C               ******************************************************
26133C               **  STEP 110--                                      **
26134C               **  TREAT THE GKS                DRIVER             **
26135C               ******************************************************
26136C
2613711000 CONTINUE
26138      GOTO9000
26139C
26140C               ******************************************************
26141C               **  STEP 120--                                      **
26142C               **  TREAT THE GD                     DRIVER         **
26143C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
26144C               **  1) JPEG                                         **
26145C               **  2) PNG                                          **
26146C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
26147C               ******************************************************
26148C
2614912000 CONTINUE
26150      GOTO9000
26151C
26152C               ******************************************************
26153C               **  STEP 130--                                      **
26154C               **  TREAT THE ABSOFT                 DRIVER         **
26155C               ******************************************************
26156C
2615713000 CONTINUE
26158      GOTO9000
26159C
26160C               ******************************************************
26161C               **  STEP 135--                                      **
26162C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
26163C               ******************************************************
26164C
2616513500 CONTINUE
26166      GOTO9000
26167C
26168C               ******************************************************
26169C               **  STEP 150--                                      **
26170C               **  TREAT THE LATEX (EEPIC)                  DRIVER **
26171C               ******************************************************
26172C
2617315000 CONTINUE
26174      GOTO9000
26175C
26176C               ******************************************************
26177C               **  STEP 160--                                      **
26178C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
26179C               ******************************************************
26180C
2618116000 CONTINUE
26182      GOTO9000
26183C
26184C               ******************************************************
26185C               **  STEP 170--                                      **
26186C               **  TREAT THE CAIRO                          DRIVER **
26187C               ******************************************************
26188C
2618917000 CONTINUE
26190      GOTO9000
26191C
26192C               ******************************************************
26193C               **  STEP 180--                                      **
26194C               **  TREAT THE WMF                            DRIVER **
26195C               ******************************************************
26196C
2619718000 CONTINUE
26198      GOTO9000
26199C
26200C               ******************************************************
26201C               **  STEP 190--                                      **
26202C               **  TREAT THE D3                             DRIVER **
26203C               ******************************************************
26204C
2620519000 CONTINUE
26206      GOTO9000
26207C
26208C               *****************
26209C               **  STEP 90--  **
26210C               **  EXIT       **
26211C               *****************
26212C
26213 9000 CONTINUE
26214      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SEFI')THEN
26215        WRITE(ICOUT,999)
26216        CALL DPWRST('XXX','BUG ')
26217        WRITE(ICOUT,9011)
26218 9011   FORMAT('***** AT THE END       OF GRSEFI--')
26219        CALL DPWRST('XXX','BUG ')
26220        WRITE(ICOUT,9013)IERRG4,IFILLT,JFILLT,IX,NCSTR
26221 9013   FORMAT('IERRG4,IFILLT,JFILLT,IX,NCSTR = ',2(A4,2X),3I8)
26222        CALL DPWRST('XXX','BUG ')
26223        IF(NCSTR.GT.0)THEN
26224          DO9025I=1,NCSTR
26225            CALL DPCOAN(ICSTR(I:I),IASCNE)
26226            WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
26227 9026       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
26228            CALL DPWRST('XXX','BUG ')
26229 9025     CONTINUE
26230        ENDIF
26231      ENDIF
26232C
26233      RETURN
26234      END
26235      SUBROUTINE GRSEFO(ICASE,IFONT,JFONT)
26236C
26237C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, SET A FONT
26238C              ON A SPECIFIC GRAPHICS DEVICE
26239C
26240C     WRITTEN BY--JAMES J. FILLIBEN
26241C                 STATISTICAL ENGINEERING DIVISION
26242C                 INFORMATION TECHNOLOGY LABORATORY
26243C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
26244C                 GAITHERSBURG, MD 20899-8980
26245C                 PHONE--301-975-2855
26246C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
26247C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
26248C     LANGUAGE--ANSI FORTRAN (1977)
26249C     VERSION NUMBER--83.6
26250C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
26251C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
26252C                                      DRIVER OBSOLETE
26253C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
26254C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
26255C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
26256C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
26257C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
26258C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
26259C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
26260C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
26261C                                      DRIVER OBSOLETE
26262C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
26263C                                      OLD STYLE CALCOMP
26264C                                      DRIVER OBSOLETE
26265C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
26266C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
26267C                                      USE BILL MITCHELLS OPENGL
26268C                                      BINDING FOR FORTRAN
26269C     UPDATED         --OCTOBER  1996. GKS (ALAN)
26270C                                      CODED, NOT TESTED
26271C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
26272C                                      PLACEHOLDER FOR NOW
26273C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
26274C                                      PLACEHOLDER FOR NOW
26275C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
26276C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
26277C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
26278C     UPDATED         --JUNE     2000. MACINTOSH
26279C                                      PLACEHOLDER FOR NOW
26280C     UPDATED         --JUNE     2000. PC PRINTER
26281C                                      PLACEHOLDER FOR NOW
26282C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
26283C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
26284C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
26285C
26286C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
26287C
26288CWINT USE WINTERACTER
26289CINTE USE INTERACTER
26290      CHARACTER*4 ICASE
26291      CHARACTER*4 IFONT
26292C
26293      CHARACTER*130 ICSTR
26294      CHARACTER*4 ISUBN0
26295C
26296C-----COMMON----------------------------------------------------------
26297C
26298      INCLUDE 'DPCOGR.INC'
26299      INCLUDE 'DPCOBE.INC'
26300      INCLUDE 'DPCOST.INC'
26301      INCLUDE 'DPCOP2.INC'
26302C
26303C-----START POINT-----------------------------------------------------
26304C
26305      ISUBN0='SEFO'
26306      IERRG4='NO'
26307C
26308      NCSTR=(-999)
26309C
26310      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SEFO')THEN
26311        WRITE(ICOUT,999)
26312  999   FORMAT(1X)
26313        CALL DPWRST('XXX','BUG ')
26314        WRITE(ICOUT,51)
26315   51   FORMAT('***** AT THE BEGINNING OF GRSEFO--')
26316        CALL DPWRST('XXX','BUG ')
26317        WRITE(ICOUT,54)ICASE,IFONT,IMANUF,IMODEL,IBUGG4
26318   54   FORMAT('ICASE,IFONT,IMANUF,IMODEL,IBUGG4 = ',4(A4,2X),A4)
26319        CALL DPWRST('XXX','BUG ')
26320      ENDIF
26321C
26322C               ********************************************
26323C               **  STEP 1--                              **
26324C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
26325C               **  AND THE MODEL                         **
26326C               ********************************************
26327C
26328      IF(IMANUF.EQ.'QWIN')THEN
26329        GOTO4700
26330      ELSEIF(IMANUF.EQ.'POST')THEN
26331        GOTO8600
26332      ELSEIF(IMANUF.EQ.'X11 ')THEN
26333        GOTO9600
26334      ELSEIF(IMANUF.EQ.'AQUA')THEN
26335        GOTO13500
26336      ELSEIF(IMANUF.EQ.'GENE')THEN
26337        IF(IMODEL.EQ.'CODE')GOTO3200
26338        IF(IMODEL.EQ.'CGM')GOTO3300
26339        IF(IMODEL.EQ.'CGMB')GOTO3400
26340        GOTO3100
26341      ELSEIF(IMANUF.EQ.'SVG ')THEN
26342        GOTO16000
26343      ELSEIF(IMANUF.EQ.'GD  ')THEN
26344        GOTO12000
26345      ELSEIF(IMANUF.EQ.'LATE')THEN
26346        GOTO15000
26347      ELSEIF(IMANUF.EQ.'CAIR')THEN
26348        GOTO17000
26349      ELSEIF(IMANUF.EQ.'D3  ')THEN
26350        GOTO19000
26351      ELSEIF(IMANUF.EQ.'WMF ')THEN
26352        GOTO18000
26353      ELSEIF(IMANUF.EQ.'OPGL')THEN
26354        GOTO4800
26355      ELSEIF(IMANUF.EQ.'TEKT')THEN
26356        GOTO1100
26357      ELSEIF(IMANUF.EQ.'HP')THEN
26358        IF(IMODEL.EQ.'7221')GOTO2100
26359        IF(IMODEL.EQ.'2622')GOTO2300
26360        IF(IMODEL.EQ.'2623')GOTO2300
26361        IF(IMODEL.EQ.'2627')GOTO2300
26362        IF(IMODEL.EQ.'2647')GOTO2300
26363        GOTO2200
26364      ELSEIF(IMANUF.EQ.'LIBP')THEN
26365        GOTO2600
26366      ELSEIF(IMANUF.EQ.'REGI')THEN
26367        GOTO8100
26368      ELSEIF(IMANUF.EQ.'GKS ')THEN
26369        GOTO11000
26370      ELSEIF(IMANUF.EQ.'LAHE')THEN
26371        IF(IMODEL.EQ.'INTE')GOTO4900
26372        IF(IMODEL.EQ.'WINT')GOTO4950
26373        GOTO4600
26374      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
26375        GOTO13000
26376      ELSEIF(IMANUF.EQ.'QUIC')THEN
26377        GOTO9100
26378      ELSEIF(IMANUF.EQ.'CALC')THEN
26379        GOTO4100
26380      ELSEIF(IMANUF.EQ.'ZETA')THEN
26381        GOTO5100
26382      ELSEIF(IMANUF.EQ.'TURB')THEN
26383        GOTO10000
26384      ELSEIF(IMANUF.EQ.'SUN ')THEN
26385        GOTO6600
26386      ENDIF
26387      GOTO9000
26388C
26389C               ******************************************************
26390C               **  STEP 11--                                       **
26391C               **  TREAT THE TEKTRONIX CASE                        **
26392C               **  REFERENCE--XXX                                  **
26393C               ******************************************************
26394C
26395 1100 CONTINUE
26396      GOTO9000
26397C
26398C               ******************************************************
26399C               **  STEP 21--                                       **
26400C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
26401C               **  (MULTI-COLOR PENPLOTTER)                        **
26402C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
26403C               **             OPERATING AND PROGRAMMING MANUAL,    **
26404C               **             PAGE XX.                             **
26405C               ******************************************************
26406C
26407 2100 CONTINUE
26408      GOTO9000
26409C
26410C               ******************************************************
26411C               **  STEP 22--                                       **
26412C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
26413C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
26414C               **  (MULTI-COLOR PENPLOTTERS)                       **
26415C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
26416C               **             OPERATING AND PROGRAMMING MANUAL,    **
26417C               **             PAGE XX, XXX.                        **
26418C               ******************************************************
26419C
26420 2200 CONTINUE
26421      GOTO9000
26422C
26423C               **********************************************************
26424C               **  STEP 23--                                           **
26425C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
26426C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
26427C               **  (MONOCHROME DISPLAY TERMINALS)                      **
26428C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
26429C               **             REFERENCE MANUAL,                        **
26430C               **             PAGE XX-X, XXX.                          **
26431C               **********************************************************
26432C
26433 2300 CONTINUE
26434      GOTO9000
26435C
26436C               **********************************************************
26437C               **  STEP 26--                                           **
26438C               **  TREAT THE UNIX LIBPLOT            CASE              **
26439C               **********************************************************
26440C
26441 2600 CONTINUE
26442      GOTO9000
26443C
26444C               ******************************************************
26445C               **  STEP 31--                                       **
26446C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
26447C               ******************************************************
26448C
26449 3100 CONTINUE
26450C     CHANGE JANUARY 1988.  ADDED "SET GENERAL FONT [ON/OFF]".
26451C     "OFF" IMPLIES DATAPLOT WILL DRAW A SOFTWARE FONT (I.E., MOVE AND
26452C     DRAW COMMANDS)
26453C     "ON" IMPLIES THAT THE POST PROCESSOR WILL MAP A DATAPLOT FONT
26454C     TO A POST PROCESSOR FONT AND THE POST-PROCESSOR WILL DRAW THE
26455C     STRING
26456C
26457C     "NULL" TELLS THE POST-PROCESSOR THAT DATAPLOT WILL DRAW THE STRING
26458C     AS LOW LEVEL MOVE AND DRAW COMMANDS.
26459C
26460      ICSTR(1:9)='SET FONT '
26461      ICSTR(10:13)=IFONT
26462      IF(IFNTSW.EQ.'OFF'.AND.IFONT.NE.'TEKT')ICSTR(10:13)='NULL'
26463      NCSTR=13
26464      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
26465      GOTO9000
26466C
26467C               ***************************************************************
26468C               **  STEP 32--                                                **
26469C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
26470C               ***************************************************************
26471C
26472 3200 CONTINUE
26473C     CHANGE JANUARY 1988.  ADDED "SET GENERAL FONT [ON/OFF]".
26474C     "OFF" IMPLIES DATAPLOT WILL DRAW A SOFTWARE FONT (I.E., MOVE AND
26475C     DRAW COMMANDS)
26476C     "ON" IMPLIES THAT THE POST PROCESSOR WILL MAP A DATAPLOT FONT
26477C     TO A POST PROCESSOR FONT AND THE POST-PROCESSOR WILL DRAW THE
26478C     STRING
26479C
26480C     "NULL" TELLS THE POST-PROCESSOR THAT DATAPLOT WILL DRAW THE STRING
26481C     AS LOW LEVEL MOVE AND DRAW COMMANDS.
26482C
26483      ICSTR(1:5)='SEFO '
26484      ICSTR(6:9)=IFONT
26485      IF(IFNTSW.EQ.'OFF'.AND.IFONT.NE.'TEKT')ICSTR(10:13)='NULL'
26486      NCSTR=9
26487      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
26488      GOTO9000
26489C
26490C               ***************************************************************
26491C               **  STEP 33--                                                **
26492C               **  TREAT THE CGM                                CASE        **
26493C               ***************************************************************
26494C
26495 3300 CONTINUE
26496C     CHANGE JANUARY 1988.  ADDED "SET GENERAL FONT [ON/OFF]".
26497C     "OFF" IMPLIES DATAPLOT WILL DRAW A SOFTWARE FONT (I.E., MOVE AND
26498C     DRAW COMMANDS), SO METAFILE SHOULD NOT SET TEXT FONT
26499C     "ON" IMPLIES THAT THE POST PROCESSOR WILL MAP A DATAPLOT FONT
26500C     TO A POST PROCESSOR FONT AND THE POST-PROCESSOR WILL DRAW THE
26501C     STRING
26502C
26503      IF(IFNTSW.EQ.'OFF')GOTO9000
26504      ICSTR(1:14)='TEXTFONTINDEX '
26505      NCSTR=14
26506      NCHTOT=2
26507      CALL GRTRIN(JFONT,NCHTOT,ICSTR,NCSTR)
26508      ICSTR(17:17)=';'
26509      NCSTR=17
26510      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
26511      GOTO9000
26512C
26513C               ***************************************************
26514C               **  STEP 34--                                    **
26515C               **  TREAT THE CGM (BINARY)                 CASE  **
26516C               ***************************************************
26517C
26518 3400 CONTINUE
26519      GOTO9000
26520C               ******************************************************
26521C               **  STEP 41--                                       **
26522C               **  TREAT THE CALCOMP XXXXXX CASE                   **
26523C               **  (NOT DONE)                                      **
26524C               **  REFERENCE--XX                                   **
26525C               **             XX                                   **
26526C               **             PAGES XX AND XX                      **
26527C               ******************************************************
26528C
26529 4100 CONTINUE
26530      GOTO9000
26531C
26532C               ******************************************************
26533C               **  STEP 46--                                       **
26534C               **  TREAT THE LAHEY   XXXXXX CASE                   **
26535C               **  REFERENCE--Programmer's Reference, Revision C   **
26536C               **             Lahey Computer Systems, January, 1992**
26537C               **             PAGES 51 THRU 65                     **
26538C               ******************************************************
26539C
26540 4600 CONTINUE
26541      GOTO9000
26542C
26543C               ******************************************************
26544C               **  STEP 47--                                       **
26545C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
26546C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
26547C               ******************************************************
26548C
26549 4700 CONTINUE
26550      GOTO9000
26551C
26552C               ******************************************************
26553C               **  STEP 48--                                       **
26554C               **  TREAT THE OPEN-GL DRIVER                        **
26555C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
26556C               ******************************************************
26557C
26558 4800 CONTINUE
26559      GOTO9000
26560C
26561C               ******************************************************
26562C               **  STEP 49--                                       **
26563C               **  TREAT THE LAHEY INTERACTOR CASE                 **
26564C               ******************************************************
26565C
26566 4900 CONTINUE
26567      GOTO9000
26568C
26569C               ******************************************************
26570C               **  STEP 49B-                                       **
26571C               **  TREAT THE LAHEY WINTERACTOR CASE                **
26572C               ******************************************************
26573C
26574 4950 CONTINUE
26575      GOTO9000
26576C
26577C
26578C               ******************************************************
26579C               **  STEP 51--                                       **
26580C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
26581C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
26582C               **             MODELS 3600SX AND 3653SX             **
26583C               **             PAGES B-0 AND B-1                    **
26584C               ******************************************************
26585C
26586 5100 CONTINUE
26587      GOTO9000
26588C
26589C               ******************************************************
26590C               **  STEP 66--                                       **
26591C               **  TREAT THE SUN       CASE                        **
26592C               **  REFERENCE--XXX                                  **
26593C               ******************************************************
26594C
26595 6600 CONTINUE
26596      GOTO9000
26597C
26598C               ******************************************************
26599C               **  STEP 81--                                       **
26600C               **  TREAT THE REGIS     CASE                        **
26601C               **  REFERENCE--XXX                                  **
26602C               ******************************************************
26603C
26604 8100 CONTINUE
26605      GOTO9000
26606C
26607C
26608C               ******************************************************
26609C               **  STEP 86--                                       **
26610C               **  TREAT THE POSTSCRIPT CASE                       **
26611C               **  REFERENCE--XXX                                  **
26612C               ******************************************************
26613C
26614 8600 CONTINUE
26615      GOTO9000
26616C
26617C               ******************************************************
26618C               **  STEP 91--                                       **
26619C               **  TREAT THE QUIC      CASE                        **
26620C               **  REFERENCE--XXX                                  **
26621C               ******************************************************
26622C
26623 9100 CONTINUE
26624      GOTO9000
26625C
26626C
26627C               ******************************************************
26628C               **  STEP 96--                                       **
26629C               **  TREAT THE X11       CASE                        **
26630C               **  REFERENCE--XXX                                  **
26631C               ******************************************************
26632C
26633 9600 CONTINUE
26634      GOTO9000
26635C
26636C               *************************************************
26637C               **  STEP 100--                                 **
26638C               **  TREAT THE VGA VIA TURBO-C       CASE       **
26639C               **  DONE VIA settextstyle in GRWRTH & GRWRTV   **
26640C               *************************************************
26641C
2664210000 CONTINUE
26643CTURB CALL TCSEFO(IFONT)
26644      GOTO9000
26645C
26646C               ******************************************************
26647C               **  STEP 110--                                      **
26648C               **  TREAT THE GKS                DRIVER             **
26649C               ******************************************************
26650C
2665111000 CONTINUE
26652      GOTO9000
26653C
26654C               ******************************************************
26655C               **  STEP 120--                                      **
26656C               **  TREAT THE GD                     DRIVER         **
26657C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
26658C               **  1) JPEG                                         **
26659C               **  2) PNG                                          **
26660C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
26661C               ******************************************************
26662C
2666312000 CONTINUE
26664      GOTO9000
26665C
26666C               ******************************************************
26667C               **  STEP 130--                                      **
26668C               **  TREAT THE ABSOFT                 DRIVER         **
26669C               ******************************************************
26670C
2667113000 CONTINUE
26672      GOTO9000
26673C
26674C               ******************************************************
26675C               **  STEP 135--                                      **
26676C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
26677C               ******************************************************
26678C
2667913500 CONTINUE
26680COLD  CALL aqtSetFontname(IAQUFN)
26681      GOTO9000
26682C
26683C               ******************************************************
26684C               **  STEP 150--                                      **
26685C               **  TREAT THE LATEX (EEPIC)                  DRIVER **
26686C               ******************************************************
26687C
2668815000 CONTINUE
26689      GOTO9000
26690C
26691C               ******************************************************
26692C               **  STEP 160--                                      **
26693C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
26694C               ******************************************************
26695C
2669616000 CONTINUE
26697      GOTO9000
26698C
26699C               ******************************************************
26700C               **  STEP 170--                                      **
26701C               **  TREAT THE CAIRO                          DRIVER **
26702C               ******************************************************
26703C
2670417000 CONTINUE
26705      GOTO9000
26706C
26707C               ******************************************************
26708C               **  STEP 180--                                      **
26709C               **  TREAT THE WMF                            DRIVER **
26710C               ******************************************************
26711C
2671218000 CONTINUE
26713      GOTO9000
26714C
26715C               ******************************************************
26716C               **  STEP 190--                                      **
26717C               **  TREAT THE D3                             DRIVER **
26718C               ******************************************************
26719C
2672019000 CONTINUE
26721      GOTO9000
26722C
26723C               *****************
26724C               **  STEP 90--  **
26725C               **  EXIT       **
26726C               *****************
26727C
26728 9000 CONTINUE
26729      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SEFO')THEN
26730        WRITE(ICOUT,999)
26731        CALL DPWRST('XXX','BUG ')
26732        WRITE(ICOUT,9011)
26733 9011   FORMAT('***** AT THE END       OF GRSEFO--')
26734        CALL DPWRST('XXX','BUG ')
26735        WRITE(ICOUT,9013)IERRG4,IFONT,JFONT,NCSTR
26736 9013   FORMAT('IERRG4,IFONT,JFONT,NCSTR = ',2(A4,2X),2I8)
26737        CALL DPWRST('XXX','BUG ')
26738        IF(NCSTR.GT.0)THEN
26739          DO9025I=1,NCSTR
26740            CALL DPCOAN(ICSTR(I:I),IASCNE)
26741            WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
26742 9026       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
26743            CALL DPWRST('XXX','BUG ')
26744 9025     CONTINUE
26745        ENDIF
26746      ENDIF
26747C
26748      RETURN
26749      END
26750      SUBROUTINE GRSEJU(ICASE,IJUST,JJUST)
26751C
26752C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, SET A JUSTIFICATION
26753C              ON A SPECIFIC GRAPHICS DEVICE
26754C
26755C     WRITTEN BY--JAMES J. FILLIBEN
26756C                 STATISTICAL ENGINEERING DIVISION
26757C                 INFORMATION TECHNOLOGY LABORATORY
26758C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
26759C                 GAITHERSBURG, MD 20899-8980
26760C                 PHONE--301-975-2855
26761C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
26762C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
26763C     LANGUAGE--ANSI FORTRAN (1977)
26764C     VERSION NUMBER--83.6
26765C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
26766C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
26767C                                      DRIVER OBSOLETE
26768C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
26769C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
26770C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
26771C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
26772C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
26773C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
26774C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
26775C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
26776C                                      DRIVER OBSOLETE
26777C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
26778C                                      OLD STYLE CALCOMP
26779C                                      DRIVER OBSOLETE
26780C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
26781C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
26782C                                      USE BILL MITCHELLS OPENGL
26783C                                      BINDING FOR FORTRAN
26784C     UPDATED         --OCTOBER  1996. GKS (ALAN)
26785C                                      CODED, NOT TESTED
26786C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
26787C                                      PLACEHOLDER FOR NOW
26788C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
26789C                                      PLACEHOLDER FOR NOW
26790C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
26791C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
26792C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
26793C     UPDATED         --JUNE     2000. MACINTOSH
26794C                                      PLACEHOLDER FOR NOW
26795C     UPDATED         --JUNE     2000. PC PRINTER
26796C                                      PLACEHOLDER FOR NOW
26797C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
26798C     UPDATED         --FEBRUARY 2006. LATEK
26799C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
26800C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
26801C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
26802C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
26803C
26804C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
26805C
26806      CHARACTER*4 ICASE
26807      CHARACTER*4 IJUST
26808C
26809      CHARACTER*130 ICSTR
26810      CHARACTER*4 ISUBN0
26811C
26812C-----COMMON----------------------------------------------------------
26813C
26814      INCLUDE 'DPCOST.INC'
26815      INCLUDE 'DPCOGR.INC'
26816      INCLUDE 'DPCOBE.INC'
26817      INCLUDE 'DPCOP2.INC'
26818C
26819C-----START POINT-----------------------------------------------------
26820C
26821      ISUBN0='SEJU'
26822      IERRG4='NO'
26823C
26824      NCSTR=(-999)
26825C
26826      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SEJU')THEN
26827        WRITE(ICOUT,999)
26828  999   FORMAT(1X)
26829        CALL DPWRST('XXX','BUG ')
26830        WRITE(ICOUT,51)
26831   51   FORMAT('***** AT THE BEGINNING OF GRSEJU--')
26832        CALL DPWRST('XXX','BUG ')
26833        WRITE(ICOUT,52)IBUGG4,ICASE,IJUST,IMANUF,IMODEL
26834   52   FORMAT('IBUGG4,ICASE,IJUST,IMANUF,IMODEL = ',4(A4,2X),A4)
26835        CALL DPWRST('XXX','BUG ')
26836      ENDIF
26837C
26838C               ********************************************
26839C               **  STEP 1--                              **
26840C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
26841C               **  AND THE MODEL                         **
26842C               ********************************************
26843C
26844      IF(IMANUF.EQ.'QWIN')THEN
26845        GOTO4700
26846      ELSEIF(IMANUF.EQ.'POST')THEN
26847        GOTO8600
26848      ELSEIF(IMANUF.EQ.'X11 ')THEN
26849        GOTO9600
26850      ELSEIF(IMANUF.EQ.'AQUA')THEN
26851        GOTO13500
26852      ELSEIF(IMANUF.EQ.'GENE')THEN
26853        IF(IMODEL.EQ.'CODE')GOTO3200
26854        IF(IMODEL.EQ.'CGM')GOTO3300
26855        IF(IMODEL.EQ.'CGMB')GOTO3400
26856        GOTO3100
26857      ELSEIF(IMANUF.EQ.'SVG ')THEN
26858        GOTO16000
26859      ELSEIF(IMANUF.EQ.'GD  ')THEN
26860        GOTO12000
26861      ELSEIF(IMANUF.EQ.'LATE')THEN
26862        GOTO15000
26863      ELSEIF(IMANUF.EQ.'CAIR')THEN
26864        GOTO17000
26865      ELSEIF(IMANUF.EQ.'D3  ')THEN
26866        GOTO19000
26867      ELSEIF(IMANUF.EQ.'WMF ')THEN
26868        GOTO18000
26869      ELSEIF(IMANUF.EQ.'OPGL')THEN
26870        GOTO4800
26871      ELSEIF(IMANUF.EQ.'TEKT')THEN
26872        GOTO1100
26873      ELSEIF(IMANUF.EQ.'HP')THEN
26874        IF(IMODEL.EQ.'7221')GOTO2100
26875        IF(IMODEL.EQ.'2622')GOTO2300
26876        IF(IMODEL.EQ.'2623')GOTO2300
26877        IF(IMODEL.EQ.'2627')GOTO2300
26878        IF(IMODEL.EQ.'2647')GOTO2300
26879        GOTO2200
26880      ELSEIF(IMANUF.EQ.'LIBP')THEN
26881        GOTO2600
26882      ELSEIF(IMANUF.EQ.'REGI')THEN
26883        GOTO8100
26884      ELSEIF(IMANUF.EQ.'GKS ')THEN
26885        GOTO11000
26886      ELSEIF(IMANUF.EQ.'LAHE')THEN
26887        IF(IMODEL.EQ.'INTE')GOTO4900
26888        IF(IMODEL.EQ.'WINT')GOTO4950
26889        GOTO4600
26890      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
26891        GOTO13000
26892      ELSEIF(IMANUF.EQ.'QUIC')THEN
26893        GOTO9100
26894      ELSEIF(IMANUF.EQ.'CALC')THEN
26895        GOTO4100
26896      ELSEIF(IMANUF.EQ.'ZETA')THEN
26897        GOTO5100
26898      ELSEIF(IMANUF.EQ.'TURB')THEN
26899        GOTO10000
26900      ELSEIF(IMANUF.EQ.'SUN ')THEN
26901        GOTO6600
26902      ENDIF
26903      GOTO9000
26904C
26905C               ******************************************************
26906C               **  STEP 11--                                       **
26907C               **  TREAT THE TEKTRONIX CASE                        **
26908C               **  REFERENCE--XXX                                  **
26909C               ******************************************************
26910C
26911 1100 CONTINUE
26912      GOTO9000
26913C
26914C               ******************************************************
26915C               **  STEP 21--                                       **
26916C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
26917C               **  (MULTI-COLOR PENPLOTTER)                        **
26918C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
26919C               **             OPERATING AND PROGRAMMING MANUAL,    **
26920C               **             PAGE XX.                             **
26921C               ******************************************************
26922C
26923 2100 CONTINUE
26924      GOTO9000
26925C
26926C               ******************************************************
26927C               **  STEP 22--                                       **
26928C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
26929C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
26930C               **  (MULTI-COLOR PENPLOTTERS)                       **
26931C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
26932C               **             OPERATING AND PROGRAMMING MANUAL,    **
26933C               **             PAGE XX, XXX.                        **
26934C               ******************************************************
26935C
26936 2200 CONTINUE
26937      GOTO9000
26938C
26939C               **********************************************************
26940C               **  STEP 23--                                           **
26941C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
26942C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
26943C               **  (MONOCHROME DISPLAY TERMINALS)                      **
26944C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
26945C               **             REFERENCE MANUAL,                        **
26946C               **             PAGE XX-X, XXX.                          **
26947C               **********************************************************
26948C
26949 2300 CONTINUE
26950      GOTO9000
26951C
26952C
26953C               ******************************************************
26954C               **  STEP 26--                                       **
26955C               **  TREAT THE UNIX LIBPLOT  CASE                    **
26956C               ******************************************************
26957C
26958 2600 CONTINUE
26959      GOTO9000
26960C
26961C               ******************************************************
26962C               **  STEP 31--                                       **
26963C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
26964C               ******************************************************
26965C
26966 3100 CONTINUE
26967      ICSTR(1:18)='SET JUSTIFICATION '
26968      ICSTR(19:22)=IJUST
26969      NCSTR=22
26970      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
26971      GOTO9000
26972C
26973C               ***************************************************************
26974C               **  STEP 32--                                                **
26975C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
26976C               ***************************************************************
26977C
26978 3200 CONTINUE
26979      ICSTR(1:5)='SEJU '
26980      ICSTR(6:9)=IJUST
26981      NCSTR=9
26982      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
26983      GOTO9000
26984C
26985C
26986C               ******************************************************
26987C               **  STEP 33--                                       **
26988C               **  TREAT THE GENERAL CGM CASE                      **
26989C               **  REFERENCE--XXX                                  **
26990C               ******************************************************
26991C
26992 3300 CONTINUE
26993C
26994      IF(IJUSSW.EQ.'OFF')GOTO9000
26995C
26996      IF(IJUST.EQ.'LEFT')GOTO3310
26997      IF(IJUST.EQ.'CENT')GOTO3320
26998      IF(IJUST.EQ.'RIGH')GOTO3330
26999C
27000      IF(IJUST.EQ.'LJUS')GOTO3310
27001      IF(IJUST.EQ.'CJUS')GOTO3320
27002      IF(IJUST.EQ.'RJUS')GOTO3330
27003C
27004      IF(IJUST.EQ.'LEBO')GOTO3310
27005      IF(IJUST.EQ.'CEBO')GOTO3320
27006      IF(IJUST.EQ.'RIBO')GOTO3330
27007C
27008      IF(IJUST.EQ.'LECE')GOTO3340
27009      IF(IJUST.EQ.'CECE')GOTO3350
27010      IF(IJUST.EQ.'RICE')GOTO3360
27011C
27012      IF(IJUST.EQ.'LETO')GOTO3370
27013      IF(IJUST.EQ.'CETO')GOTO3380
27014      IF(IJUST.EQ.'RITO')GOTO3390
27015C
27016      GOTO3310
27017C
27018 3310 CONTINUE
27019      ICSTR(1:26)='TEXTALIGN LEFT,BOTTOM,0,0;'
27020      NCSTR=26
27021      GOTO3399
27022C
27023 3320 CONTINUE
27024      ICSTR(1:25)='TEXTALIGN CTR,BOTTOM,0,0;'
27025      NCSTR=25
27026      GOTO3399
27027C
27028 3330 CONTINUE
27029      ICSTR(1:27)='TEXTALIGN RIGHT,BOTTOM,0,0;'
27030      NCSTR=27
27031      GOTO3399
27032C
27033 3340 CONTINUE
27034      ICSTR(1:24)='TEXTALIGN LEFT,HALF,0,0;'
27035      NCSTR=24
27036      GOTO3399
27037C
27038 3350 CONTINUE
27039      ICSTR(1:23)='TEXTALIGN CTR,HALF,0,0;'
27040      NCSTR=23
27041      GOTO3399
27042C
27043 3360 CONTINUE
27044      ICSTR(1:25)='TEXTALIGN RIGHT,HALF,0,0;'
27045      NCSTR=25
27046      GOTO3399
27047C
27048 3370 CONTINUE
27049      ICSTR(1:23)='TEXTALIGN LEFT,TOP,0,0;'
27050      NCSTR=23
27051      GOTO3399
27052C
27053 3380 CONTINUE
27054      ICSTR(1:22)='TEXTALIGN CTR,TOP,0,0;'
27055      NCSTR=22
27056      GOTO3399
27057C
27058 3390 CONTINUE
27059      ICSTR(1:24)='TEXTALIGN RIGHT,TOP,0,0;'
27060      NCSTR=24
27061      GOTO3399
27062C
27063 3399 CONTINUE
27064      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
27065      GOTO9000
27066C
27067C               ***************************************************
27068C               **  STEP 34--                                    **
27069C               **  TREAT THE CGM (BINARY)                 CASE  **
27070C               ***************************************************
27071C
27072 3400 CONTINUE
27073      GOTO9000
27074C
27075C               ******************************************************
27076C               **  STEP 41--                                       **
27077C               **  TREAT THE CALCOMP XXXXXX CASE                   **
27078C               **  (NOT DONE)                                      **
27079C               **  REFERENCE--XX                                   **
27080C               **             XX                                   **
27081C               **             PAGES XX AND XX                      **
27082C               ******************************************************
27083C
27084 4100 CONTINUE
27085      GOTO9000
27086C
27087C               ******************************************************
27088C               **  STEP 46--                                       **
27089C               **  TREAT THE LAHEY   XXXXXX CASE                   **
27090C               **  REFERENCE--Programmer's Reference, Revision C   **
27091C               **             Lahey Computer Systems, January, 1992**
27092C               **             PAGES 51 THRU 65                     **
27093C               ******************************************************
27094C
27095 4600 CONTINUE
27096      GOTO9000
27097C
27098C               ******************************************************
27099C               **  STEP 47--                                       **
27100C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
27101C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
27102C               ******************************************************
27103C
27104 4700 CONTINUE
27105      GOTO9000
27106C
27107C               ******************************************************
27108C               **  STEP 48--                                       **
27109C               **  TREAT THE OPEN-GL DRIVER                        **
27110C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
27111C               ******************************************************
27112C
27113 4800 CONTINUE
27114      GOTO9000
27115C
27116C               ******************************************************
27117C               **  STEP 49--                                       **
27118C               **  TREAT THE LAHEY INTERACTOR CASE                 **
27119C               ******************************************************
27120C
27121 4900 CONTINUE
27122      GOTO9000
27123C
27124C               ******************************************************
27125C               **  STEP 49B-                                       **
27126C               **  TREAT THE LAHEY WINTERACTOR CASE                **
27127C               ******************************************************
27128C
27129 4950 CONTINUE
27130      GOTO9000
27131C
27132C
27133C               ******************************************************
27134C               **  STEP 51--                                       **
27135C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
27136C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
27137C               **             MODELS 3600SX AND 3653SX             **
27138C               **             PAGES B-0 AND B-1                    **
27139C               ******************************************************
27140C
27141 5100 CONTINUE
27142      GOTO9000
27143C
27144C
27145C               ******************************************************
27146C               **  STEP 66--                                       **
27147C               **  TREAT THE SUN       CASE                        **
27148C               **  REFERENCE--XXX                                  **
27149C               ******************************************************
27150C
27151 6600 CONTINUE
27152      GOTO9000
27153C
27154C
27155C               ******************************************************
27156C               **  STEP 81--                                       **
27157C               **  TREAT THE REGIS     CASE                        **
27158C               **  REFERENCE--XXX                                  **
27159C               ******************************************************
27160C
27161 8100 CONTINUE
27162      GOTO9000
27163C
27164C
27165C               ******************************************************
27166C               **  STEP 86--                                       **
27167C               **  TREAT THE POSTSCRIPT CASE                       **
27168C               **  REFERENCE--XXX                                  **
27169C               ******************************************************
27170C
27171 8600 CONTINUE
27172      GOTO9000
27173C
27174C
27175C               ******************************************************
27176C               **  STEP 91--                                       **
27177C               **  TREAT THE QUIC      CASE                        **
27178C               **  REFERENCE--XXX                                  **
27179C               ******************************************************
27180C
27181 9100 CONTINUE
27182      GOTO9000
27183C
27184C
27185C               ******************************************************
27186C               **  STEP 96--                                       **
27187C               **  TREAT THE X11       CASE                        **
27188C               **  REFERENCE--XXX                                  **
27189C               ******************************************************
27190C
27191 9600 CONTINUE
27192      GOTO9000
27193C
27194C               *************************************************
27195C               **  STEP 100--                                 **
27196C               **  TREAT THE VGA VIA TURBO-C       CASE       **
27197C               **  DONE VIA settextjustify in GRWRTH & GRWRTV **
27198C               *************************************************
27199C
2720010000 CONTINUE
27201CTURB CALL TCSEJU(IJUST)
27202      GOTO9000
27203C
27204C               ******************************************************
27205C               **  STEP 110--                                      **
27206C               **  TREAT THE GKS                DRIVER             **
27207C               ******************************************************
27208C
2720911000 CONTINUE
27210      GOTO9000
27211C
27212C               ******************************************************
27213C               **  STEP 120--                                      **
27214C               **  TREAT THE GD                     DRIVER         **
27215C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
27216C               **  1) JPEG                                         **
27217C               **  2) PNG                                          **
27218C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
27219C               ******************************************************
27220C
2722112000 CONTINUE
27222      GOTO9000
27223C
27224C               ******************************************************
27225C               **  STEP 130--                                      **
27226C               **  TREAT THE ABSOFT                 DRIVER         **
27227C               ******************************************************
27228C
2722913000 CONTINUE
27230      GOTO9000
27231C
27232C               ******************************************************
27233C               **  STEP 135--                                      **
27234C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
27235C               ******************************************************
27236C
2723713500 CONTINUE
27238      GOTO9000
27239C
27240C
27241C               ******************************************************
27242C               **  STEP 150--                                      **
27243C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
27244C               ******************************************************
27245C
2724615000 CONTINUE
27247      GOTO9000
27248C
27249C               ******************************************************
27250C               **  STEP 160--                                      **
27251C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
27252C               ******************************************************
27253C
2725416000 CONTINUE
27255      GOTO9000
27256C
27257C               ******************************************************
27258C               **  STEP 170--                                      **
27259C               **  TREAT THE CAIRO                          DRIVER **
27260C               ******************************************************
27261C
2726217000 CONTINUE
27263      GOTO9000
27264C
27265C               ******************************************************
27266C               **  STEP 180--                                      **
27267C               **  TREAT THE WMF                            DRIVER **
27268C               ******************************************************
27269C
2727018000 CONTINUE
27271      GOTO9000
27272C
27273C               ******************************************************
27274C               **  STEP 190--                                      **
27275C               **  TREAT THE D3                             DRIVER **
27276C               ******************************************************
27277C
2727819000 CONTINUE
27279      GOTO9000
27280C
27281C               *****************
27282C               **  STEP 90--  **
27283C               **  EXIT       **
27284C               *****************
27285C
27286 9000 CONTINUE
27287      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SEJU')THEN
27288        WRITE(ICOUT,999)
27289        CALL DPWRST('XXX','BUG ')
27290        WRITE(ICOUT,9011)
27291 9011   FORMAT('***** AT THE END       OF GRSEJU--')
27292        CALL DPWRST('XXX','BUG ')
27293        WRITE(ICOUT,9023)JJUST,NCSTR,IERRG4
27294 9023   FORMAT('JJUST,NCSTR,IERRG4 = ',2I8,2X,A4)
27295        CALL DPWRST('XXX','BUG ')
27296        IF(NCSTR.LE.0)THEN
27297          DO9025I=1,NCSTR
27298            CALL DPCOAN(ICSTR(I:I),IASCNE)
27299            WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
27300 9026       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
27301            CALL DPWRST('XXX','BUG ')
27302 9025     CONTINUE
27303        ENDIF
27304      ENDIF
27305C
27306      RETURN
27307      END
27308      SUBROUTINE GRSEMO(IGRASW,PDIAXC,PDIAYC)
27309C
27310C     PURPOSE--SET TERMINAL INTO GRAPHICS MODE OR TO DIAGLOGUE MODE
27311C              ON A SPECIFIC GRAPHICS DEVICE.
27312C
27313C     WRITTEN BY--JAMES J. FILLIBEN
27314C                 STATISTICAL ENGINEERING DIVISION
27315C                 INFORMATION TECHNOLOGY LABORATORY
27316C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
27317C                 GAITHERSBURG, MD 20899-8980
27318C                 PHONE--301-975-2855
27319C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
27320C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
27321C     LANGUAGE--ANSI FORTRAN (1977)
27322C     VERSION NUMBER--83.6
27323C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
27324C     UPDATED         --JANUARY  1989.  SUN (BY BILL ANDERSON)
27325C     UPDATED         --JANUARY  1989.  POSTSCRIPT (BY ALAN HECKERT)
27326C     UPDATED         --JANUARY  1989.  CGM (BY ALAN HECKERT)
27327C     UPDATED         --JANUARY  1989.  QMS QUIC (BY ALAN HECKERT)
27328C     UPDATED         --JANUARY  1989.  CALCOMP (BY ALAN HECKERT)
27329C     UPDATED         --JANUARY  1989.  ZETA (BY ALAN HECKERT)
27330C     UPDATED         --APRIL    1989.  SOFT-CODE BACKSLASH FOR UNIX
27331C     UPDATED         --MARCH    1990.  X11 (BY ALAN HECKERT)
27332C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
27333C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
27334C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
27335C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
27336C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
27337C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
27338C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
27339C
27340C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
27341C
27342      CHARACTER*4 IGRASW
27343C
27344      CHARACTER*130 ICSTR
27345      CHARACTER*4 ISUBN0
27346      CHARACTER*4 IC4
27347C
27348C-----COMMON----------------------------------------------------------
27349C
27350      INCLUDE 'DPCOGR.INC'
27351      INCLUDE 'DPCONP.INC'
27352      INCLUDE 'DPCOBE.INC'
27353      INCLUDE 'DPCOP2.INC'
27354C
27355C-----START POINT-----------------------------------------------------
27356C
27357      ISUBN0='SEMO'
27358      IERRG4='NO'
27359C
27360      NCSTR=(-999)
27361C
27362      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SEMO')THEN
27363        WRITE(ICOUT,999)
27364  999   FORMAT(1X)
27365        CALL DPWRST('XXX','BUG ')
27366        WRITE(ICOUT,51)
27367   51   FORMAT('***** AT THE BEGINNING OF GRSEMO--')
27368        CALL DPWRST('XXX','BUG ')
27369        WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3
27370   52   FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',3(A4,2X),A4)
27371        CALL DPWRST('XXX','BUG ')
27372        WRITE(ICOUT,53)IGUNIT,IGBAUD,PDIAXC,PDIAYC
27373   53   FORMAT('IGUNIT,IGBAUD,PDIAXC,PDIAYC = ',2I8,2G15.7)
27374        CALL DPWRST('XXX','BUG ')
27375        WRITE(ICOUT,54)IGCODE,ISOFT,ISOFT2,ISOFT3
27376   54   FORMAT('IGCODE,ISOFT,ISOFT2,ISOFT3 = ',3(A4,2X),A4)
27377        CALL DPWRST('XXX','BUG ')
27378        WRITE(ICOUT,59)IGRASW,IBUGG4,ISUBG4,IERRG4
27379   59   FORMAT('IGRASW,IBUGG4,ISUBG4,IERRG4 = ',3(A4,2X),A4)
27380        CALL DPWRST('XXX','BUG ')
27381      ENDIF
27382C
27383C               ********************************************
27384C               **  STEP 1--                              **
27385C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
27386C               **  AND THE MODEL                         **
27387C               ********************************************
27388C
27389      IF(IMANUF.EQ.'QWIN')THEN
27390        GOTO4700
27391      ELSEIF(IMANUF.EQ.'POST')THEN
27392        GOTO8600
27393      ELSEIF(IMANUF.EQ.'X11 ')THEN
27394        GOTO9600
27395      ELSEIF(IMANUF.EQ.'AQUA')THEN
27396        GOTO13500
27397      ELSEIF(IMANUF.EQ.'GENE')THEN
27398        IF(IMODEL.EQ.'CODE')GOTO3200
27399        IF(IMODEL.EQ.'CGM')GOTO3300
27400        IF(IMODEL.EQ.'CGMB')GOTO3300
27401        GOTO3100
27402      ELSEIF(IMANUF.EQ.'SVG ')THEN
27403        GOTO16000
27404      ELSEIF(IMANUF.EQ.'GD  ')THEN
27405        GOTO12000
27406      ELSEIF(IMANUF.EQ.'LATE')THEN
27407        GOTO15000
27408      ELSEIF(IMANUF.EQ.'CAIR')THEN
27409        GOTO17000
27410      ELSEIF(IMANUF.EQ.'D3  ')THEN
27411        GOTO19000
27412      ELSEIF(IMANUF.EQ.'WMF ')THEN
27413        GOTO18000
27414      ELSEIF(IMANUF.EQ.'OPGL')THEN
27415        GOTO4800
27416      ELSEIF(IMANUF.EQ.'TEKT')THEN
27417        IF(IMODEL.EQ.'4020')GOTO1100
27418        IF(IMODEL.EQ.'4022')GOTO1100
27419        IF(IMODEL.EQ.'4025')GOTO1100
27420        IF(IMODEL.EQ.'4027')GOTO1100
27421C
27422        IF(IMODEL.EQ.'4105')GOTO1200
27423        IF(IMODEL.EQ.'4107')GOTO1200
27424        IF(IMODEL.EQ.'4109')GOTO1200
27425        IF(IMODEL.EQ.'4115')GOTO1200
27426        IF(IMODEL.EQ.'4107')GOTO1200
27427        IF(IMODEL.EQ.'4113')GOTO1200
27428C
27429        GOTO9000
27430      ELSEIF(IMANUF.EQ.'HP')THEN
27431        IF(IMODEL.EQ.'7221')GOTO2100
27432        IF(IMODEL.EQ.'2622')GOTO2300
27433        IF(IMODEL.EQ.'2623')GOTO2300
27434        IF(IMODEL.EQ.'2627')GOTO2300
27435        IF(IMODEL.EQ.'2647')GOTO2300
27436        GOTO2200
27437      ELSEIF(IMANUF.EQ.'LIBP')THEN
27438        GOTO2600
27439      ELSEIF(IMANUF.EQ.'REGI')THEN
27440        GOTO8100
27441      ELSEIF(IMANUF.EQ.'GKS ')THEN
27442        GOTO11000
27443      ELSEIF(IMANUF.EQ.'LAHE')THEN
27444        IF(IMODEL.EQ.'INTE')GOTO4900
27445        IF(IMODEL.EQ.'WINT')GOTO4950
27446        GOTO4600
27447      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
27448        GOTO13000
27449      ELSEIF(IMANUF.EQ.'QUIC')THEN
27450        GOTO9100
27451      ELSEIF(IMANUF.EQ.'CALC')THEN
27452        GOTO4100
27453      ELSEIF(IMANUF.EQ.'ZETA')THEN
27454        GOTO5100
27455      ELSEIF(IMANUF.EQ.'TURB')THEN
27456        GOTO10000
27457      ELSEIF(IMANUF.EQ.'SUN ')THEN
27458        GOTO6600
27459      ENDIF
27460      GOTO9000
27461C
27462C               ******************************************************
27463C               **  STEP 11--                                       **
27464C               **  TREAT THE 4027 CASE--                           **
27465C               **  (A COLOR TERMINAL).                             **
27466C               **  EXCLAMATION POINT MON K  (PAGE XXX)             **
27467C               ******************************************************
27468C
27469C     CORRECTIONS PROVIDED BY MARIA ZIMMER
27470C     WRIGHT-PATTERSON AFB, OHIO   JANUARY 1985
27471C
27472 1100 CONTINUE
27473      IF(IGRASW.EQ.'ON')GOTO9000
27474      ICSTR(1:6)='!MON K'
27475      NCSTR=6
27476      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
27477      GOTO9000
27478C
27479C               ******************************************************
27480C               **  STEP 12--                                       **
27481C               **  TREAT THE TEKTRONIX 4105 CASE                   **
27482C               **  (A COLOR DEVICE)                                **
27483C               **  1. ENABLE DIALOGUE AREA                         **
27484C               **     ESCAPE KA1   (PAGE 5-14)                     **
27485C               **  2. ERASE DIAGLOUE AREA (AND BUFFER)             **
27486C               **     ESCAPE LZ     (PAGE 5-8)                     **
27487C               **     THIS IS A PATCH SO THAT AFTER A PLOT IS FORME**
27488C               **     THE DIALGOU WILL NOT IMMEDIATELY APPEAR ATOP **
27489C               **     BETTER SOLUTION IS TO PLACE DIALOGUE CURSOR A**
27490C               **     TOP OF SCREEN BUT PROBABLY CANNOT DO IT      **
27491C               **     ON 4105                                      **
27492C               **     NET EFFECT IS THAT WHENEVER DIALOGUEMODE IS  **
27493C               **     ENTERED, THE DIAGOGUE BUFFER WILL BE ERASED. **
27494C               **  3. MAKE DIALOGUE AREA VISIBLE                   **
27495C               **     ESCAPE LV1      (PAGE 5-39)                  **
27496C               ** 11. DISABLE DIALOGUE AREA                        **
27497C               **     ESCAPE KA0   (PAGE 5-14)                     **
27498C               ** 12. MAKE DIALOGUE AREA INVISIBLE                 **
27499C               **     ESCAPE LV0      (PAGE 5-39)                  **
27500C               ******************************************************
27501C
27502 1200 CONTINUE
27503      IF(IGRASW.EQ.'OFF')THEN
27504        ICSTR(1:1)=IESCC
27505        ICSTR(2:4)='KA1'
27506        NCSTR=4
27507        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
27508C       THE FOLLOWING 3-LINE 4105 ETC. PATCH WAS ENTERED AUGUST 25, 1986
27509        ICSTR(1:1)=IUSC
27510        NCSTR=1
27511        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
27512        ICSTR(1:1)=IESCC
27513        ICSTR(2:3)='LZ'
27514        NCSTR=3
27515        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
27516        ICSTR(1:1)=IESCC
27517        ICSTR(2:4)='LV1'
27518        NCSTR=4
27519        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
27520      ELSE
27521        ICSTR(1:1)=IESCC
27522        ICSTR(2:4)='KA0'
27523        NCSTR=4
27524        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
27525        ICSTR(1:1)=IESCC
27526        ICSTR(2:4)='LV0'
27527        NCSTR=4
27528        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
27529      ENDIF
27530C
27531      GOTO9000
27532C
27533C               ******************************************************
27534C               **  STEP 21--                                       **
27535C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
27536C               **  (MULTI-COLOR PENPLOTTER)                        **
27537C               **  THERE IS NO   SET MODE    INSTRUCTION PER SE.   **
27538C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
27539C               **             OPERATING AND PROGRAMMING MANUAL,    **
27540C               **             PAGE XX.                             **
27541C               ******************************************************
27542C
27543 2100 CONTINUE
27544      GOTO9000
27545C
27546C               ******************************************************
27547C               **  STEP 22--                                       **
27548C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
27549C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
27550C               **  (MULTI-COLOR PENPLOTTERS)                       **
27551C               **  THERE IS NO   SET MODE    INSTRUCTION PER SE.   **
27552C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
27553C               **             OPERATING AND PROGRAMMING MANUAL,    **
27554C               **             PAGE XX, XXX.                        **
27555C               ******************************************************
27556C
27557 2200 CONTINUE
27558      GOTO9000
27559C
27560C               **********************************************************
27561C               **  STEP 23--                                           **
27562C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
27563C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
27564C               **  (MONOCHROME DISPLAY TERMINALS)                      **
27565C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
27566C               **             REFERENCE MANUAL,                        **
27567C               **             PAGE 10-4, XXX.                          **
27568C               **********************************************************
27569C
27570 2300 CONTINUE
27571      IF(IGRASW.EQ.'OFF')THEN
27572        ICSTR(1:1)=IESCC
27573        ICSTR(2:5)='*deZ'
27574        NCSTR=5
27575        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
27576      ELSE
27577        ICSTR(1:1)=IESCC
27578        ICSTR(2:5)='*dcZ'
27579        NCSTR=5
27580      ENDIF
27581C
27582      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
27583      GOTO9000
27584C
27585C               **********************************************************
27586C               **  STEP 26--                                           **
27587C               **  TREAT THE UNIX LIBPLOT  CASE                        **
27588C               **********************************************************
27589C
27590 2600 CONTINUE
27591      GOTO9000
27592C
27593C               ******************************************************
27594C               **  STEP 31--                                       **
27595C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
27596C               ******************************************************
27597C
27598 3100 CONTINUE
27599      IF(IGRASW.EQ.'OFF')THEN
27600        ICSTR(1:19)='ENTER DIALOGUE MODE'
27601        NCSTR=19
27602        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
27603      ELSE
27604        ICSTR(1:19)='ENTER GRAPHICS MODE'
27605        NCSTR=19
27606        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
27607      ENDIF
27608      GOTO9000
27609C
27610C               ***************************************************************
27611C               **  STEP 32--                                                **
27612C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
27613C               ***************************************************************
27614C
27615 3200 CONTINUE
27616      IF(IGRASW.EQ.'OFF')THEN
27617        ICSTR(1:5)='SEMO '
27618        ICSTR(6:9)='DIAL'
27619        NCSTR=9
27620        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
27621      ELSE
27622        ICSTR(1:5)='SEMO '
27623        ICSTR(6:9)='GRAP'
27624        NCSTR=9
27625        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
27626      ENDIF
27627      GOTO9000
27628C
27629C               ***************************************************************
27630C               **  STEP 32--                                                **
27631C               **  TREAT THE CGM   GENERAL (DEVICE-INDEPENDENT) CASE        **
27632C               **  CGM DOES NOT SUPPORT THIS FEATURE                        **
27633C               ***************************************************************
27634C
27635 3300 CONTINUE
27636      GOTO9000
27637C
27638C               ******************************************************
27639C               **  STEP 41--                                       **
27640C               **  TREAT THE CALCOMP XXXXXX CASE                   **
27641C               **  TO SET MODE--                                   **
27642C               **  OFFLINE DEVICE, NULL ROUTINE                    **
27643C               **  (NOT DONE)                                      **
27644C               **  REFERENCE--XX                                   **
27645C               **             XX                                   **
27646C               **             PAGES XX AND XX                      **
27647C               ******************************************************
27648C
27649 4100 CONTINUE
27650      GOTO9000
27651C
27652C               ******************************************************
27653C               **  STEP 46--                                       **
27654C               **  TREAT THE LAHEY   XXXXXX CASE                   **
27655C               **  REFERENCE--Programmer's Reference, Revision C   **
27656C               **             Lahey Computer Systems, January, 1992**
27657C               **             PAGES 51 THRU 65                     **
27658C               ******************************************************
27659C
27660 4600 CONTINUE
27661      GOTO9000
27662C
27663C               ******************************************************
27664C               **  STEP 47--                                       **
27665C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
27666C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
27667C               ******************************************************
27668C
27669 4700 CONTINUE
27670      GOTO9000
27671C
27672C               ******************************************************
27673C               **  STEP 48--                                       **
27674C               **  TREAT THE OPEN-GL DRIVER                        **
27675C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
27676C               ******************************************************
27677C
27678 4800 CONTINUE
27679      GOTO9000
27680C
27681C               ******************************************************
27682C               **  STEP 49--                                       **
27683C               **  TREAT THE LAHEY INTERACTOR CASE                 **
27684C               ******************************************************
27685C
27686 4900 CONTINUE
27687      GOTO9000
27688C
27689C               ******************************************************
27690C               **  STEP 49B-                                       **
27691C               **  TREAT THE LAHEY WINTERACTOR CASE                **
27692C               ******************************************************
27693C
27694 4950 CONTINUE
27695      GOTO9000
27696C
27697C               ******************************************************
27698C               **  STEP 51--                                       **
27699C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
27700C               **  THERE IS NO   SET MODE    INSTRUCTION PER SE.   **
27701C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
27702C               **             MODELS 3600SX AND 3653SX             **
27703C               **             PAGES B-0 AND B-1                    **
27704C               ******************************************************
27705C
27706 5100 CONTINUE
27707      GOTO9000
27708C
27709C               ******************************************************
27710C               **  STEP 66--                                       **
27711C               **  TREAT THE SUN CASE - NULL ROUTINE               **
27712C               ******************************************************
27713C
27714 6600 CONTINUE
27715      GOTO 9000
27716C
27717C               ******************************************************
27718C               **  STEP 81--                                       **
27719C               **  TREAT THE DEC  REGIS CASE                       **
27720C               **  TO GO INTO ALPHA    MODE---                     **
27721C               **  WRITE OUT AN ESC BACKSLASH                      **
27722C               **  TO GO INTO GRAPHICS MODE---                     **
27723C               **  WRITE OUT AN ESC P p                            **
27724C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
27725C               **             PAGES 96                             **
27726C               ******************************************************
27727C
27728 8100 CONTINUE
27729      IF(IGRASW.EQ.'OFF')THEN
27730        ICSTR(1:1)=IESCC
27731CCCCC   THE FOLLOWING LINE WAS FIXED (SOFT-CODE BACKSLASH) APRIL 1989
27732        ICSTR(2:2)=IBASLC
27733        NCSTR=2
27734        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
27735      ELSE
27736        ICSTR(1:1)=IESCC
27737        ICSTR(2:3)='Pp'
27738        NCSTR=3
27739        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
27740      ENDIF
27741      GOTO9000
27742C
27743C               ******************************************************
27744C               **  STEP 86--                                       **
27745C               **  TREAT THE POSTSCRIPT CASE                       **
27746C               ******************************************************
27747C
27748 8600 CONTINUE
27749      GOTO9000
27750C
27751C               ******************************************************
27752C               **  STEP 91--                                       **
27753C               **  TREAT THE QUIC       CASE                       **
27754C               ******************************************************
27755C
27756 9100 CONTINUE
27757      GOTO9000
27758C
27759C               ******************************************************
27760C               **  STEP 95--                                       **
27761C               **  TREAT THE X11        CASE                       **
27762C               ******************************************************
27763C
27764 9600 CONTINUE
27765      GOTO9000
27766C
27767C               *************************************************
27768C               **  STEP 100--                                 **
27769C               **  TREAT THE VGA VIA TURBO-C       CASE       **
27770C               *************************************************
27771C
2777210000 CONTINUE
27773      IC4='DIAL'
27774      IF(IGRASW.EQ.'ON')IC4='GRAP'
27775CTURB CALL TCSEMO(IC4)
27776      GOTO9000
27777C
27778C               ******************************************************
27779C               **  STEP 110--                                      **
27780C               **  TREAT THE GKS                DRIVER             **
27781C               ******************************************************
27782C
2778311000 CONTINUE
27784      GOTO9000
27785C
27786C               ******************************************************
27787C               **  STEP 120--                                      **
27788C               **  TREAT THE GD                     DRIVER         **
27789C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
27790C               **  1) JPEG                                         **
27791C               **  2) PNG                                          **
27792C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
27793C               ******************************************************
27794C
2779512000 CONTINUE
27796      GOTO9000
27797C
27798C               ******************************************************
27799C               **  STEP 130--                                      **
27800C               **  TREAT THE ABSOFT                 DRIVER         **
27801C               ******************************************************
27802C
2780313000 CONTINUE
27804      GOTO9000
27805C
27806C               ******************************************************
27807C               **  STEP 135--                                      **
27808C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
27809C               ******************************************************
27810C
2781113500 CONTINUE
27812      GOTO9000
27813C
27814C               ******************************************************
27815C               **  STEP 150--                                      **
27816C               **  TREAT THE LATEX (EEPIC)                  DRIVER **
27817C               ******************************************************
27818C
2781915000 CONTINUE
27820      GOTO9000
27821C
27822C               ******************************************************
27823C               **  STEP 160--                                      **
27824C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
27825C               ******************************************************
27826C
2782716000 CONTINUE
27828      GOTO9000
27829C
27830C               ******************************************************
27831C               **  STEP 170--                                      **
27832C               **  TREAT THE CAIRO                          DRIVER **
27833C               ******************************************************
27834C
2783517000 CONTINUE
27836      GOTO9000
27837C
27838C               ******************************************************
27839C               **  STEP 180--                                      **
27840C               **  TREAT THE WMF                            DRIVER **
27841C               ******************************************************
27842C
2784318000 CONTINUE
27844      GOTO9000
27845C
27846C               ******************************************************
27847C               **  STEP 190--                                      **
27848C               **  TREAT THE D3                             DRIVER **
27849C               ******************************************************
27850C
2785119000 CONTINUE
27852      GOTO9000
27853C
27854C               *****************
27855C               **  STEP 90--  **
27856C               **  EXIT       **
27857C               *****************
27858C
27859 9000 CONTINUE
27860      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SEMO')THEN
27861        WRITE(ICOUT,999)
27862        CALL DPWRST('XXX','BUG ')
27863        WRITE(ICOUT,9011)
27864 9011   FORMAT('***** AT THE END       OF GRSEMO--')
27865        CALL DPWRST('XXX','BUG ')
27866        WRITE(ICOUT,9023)NCSTR,IERRG4
27867 9023   FORMAT('NCSTR,IERRG4 = ',I8,2X,A4)
27868        CALL DPWRST('XXX','BUG ')
27869        IF(NCSTR.GT.0)THEN
27870          DO9025I=1,NCSTR
27871            CALL DPCOAN(ICSTR(I:I),IASCNE)
27872            WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
27873 9026       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
27874            CALL DPWRST('XXX','BUG ')
27875 9025     CONTINUE
27876        ENDIF
27877      ENDIF
27878C
27879      RETURN
27880      END
27881      SUBROUTINE GRSEPA(ICASE,IPATTT,PXSPA,PYSPA,
27882     1JPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
27883C
27884C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, SET A PATTERN
27885C              ON A SPECIFIC GRAPHICS DEVICE
27886C
27887C     WRITTEN BY--JAMES J. FILLIBEN
27888C                 STATISTICAL ENGINEERING DIVISION
27889C                 INFORMATION TECHNOLOGY LABORATORY
27890C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
27891C                 GAITHERSBURG, MD 20899-8980
27892C                 PHONE--301-975-2899
27893C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
27894C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
27895C     LANGUAGE--ANSI FORTRAN (1977)
27896C     VERSION NUMBER--83.6
27897C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
27898C     UPDATED         --JANUARY   1989. SUN (BY BILL ANDERSON)
27899C                                       DRIVER OBSOLETE
27900C     UPDATED         --JANUARY   1989. POSTSCRIPT (BY ALAN HECKERT)
27901C     UPDATED         --JANUARY   1989. CGM (BY ALAN HECKERT)
27902C     UPDATED         --JANUARY   1989. QMS QUIC (BY ALAN HECKERT)
27903C     UPDATED         --JANUARY   1989. CALCOMP (BY ALAN HECKERT)
27904C     UPDATED         --JANUARY   1989. ZETA (BY ALAN HECKERT)
27905C     UPDATED         --MARCH     1990. X11 (BY ALAN HECKERT)
27906C     UPDATED         --MAY       1991. ISUBNO TO ISUBN0 (JJF)
27907C     UPDATED         --MAY       1991. RENUMBER TOP BRANCHES (JJF)
27908C     UPDATED         --MAY       1991. VGA/TURBOC DRIVER (JJF)
27909C                                       DRIVER OBSOLETE
27910C     UPDATED         --JULY      1996. LAHEY DRIVER (ALAN HECKERT)
27911C                                       OLD STYLE CALCOMP
27912C                                       DRIVER OBSOLETE
27913C     UPDATED         --OCTOBER   1996. QUICKWIN DRIVER (ALAN)
27914C     UPDATED         --OCTOBER   1996. OPENGL DRIVER (ALAN)
27915C                                       USE BILL MITCHELLS OPENGL
27916C                                       BINDING FOR FORTRAN
27917C     UPDATED         --OCTOBER   1996. GKS (ALAN)
27918C                                       CODED, NOT TESTED
27919C     UPDATED         --OCTOBER   1996. BINARY CGM (ALAN)
27920C                                       PLACEHOLDER FOR NOW
27921C     UPDATED         --OCTOBER   1996. DISPLAY POSTSCRIPT (ALAN)
27922C                                       PLACEHOLDER FOR NOW
27923C     UPDATED         --OCTOBER   1996. BLANK PATTERN (JPATTT=-1) ON
27924C                                       SOME DEVICES
27925C     UPDATED         --OCTOBER   1997. LAHEY INTERACTOR (ALAN)
27926C     UPDATED         --JULY      1998. LAHEY WINTERACTOR
27927C     UPDATED         --JUNE      2000. GD (FOR JPEG, PNG, WINDOWS BMP)
27928C     UPDATED         --JUNE      2000. MACINTOSH
27929C                                       PLACEHOLDER FOR NOW
27930C                     --MARCH     2002. CHANGE TO QUARTZ (NEW MAC GRAPHICS
27931C                                       LIBRARY)
27932C     UPDATED         --JUNE      2000. PC PRINTER
27933C                                       PLACEHOLDER FOR NOW
27934C                     --MARCH     2002. CHANGE TO GHOSTSCRIPT
27935C     UPDATED         --MARCH     2002. LATEX (USING EEPIC)
27936C                                       PLACEHOLDER FOR NOW
27937C     UPDATED         --MARCH     2002. SVG (SCALABLE VECTOR GRAPHICS)
27938C     UPDATED         --SEPTEMBER 2007. SUPPORT FOR AQUATERM
27939C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
27940C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
27941C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
27942C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
27943C
27944C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
27945C
27946#ifdef HAVE_WININTERACTER
27947      USE WINTERACTER
27948#endif
27949#ifdef HAVE_INTERACTER
27950      USE INTERACTER
27951#endif
27952#ifdef HAVE_QWIN
27953CQWIN USE DFLIB
27954      USE IFQWIN
27955      INTEGER(2) STYLE
27956#endif
27957C
27958      CHARACTER*4 ICASE
27959      CHARACTER*4 IPATTT
27960      CHARACTER*4 IHORPA
27961      CHARACTER*4 IVERPA
27962      CHARACTER*4 IDUPPA
27963      CHARACTER*4 IDDOPA
27964      CHARACTER*1 IPATTZ
27965      CHARACTER*130 ICSTR
27966      CHARACTER*4 ISUBN0
27967C
27968      DIMENSION ARRCAL(10)
27969      DIMENSION XPATT(8)
27970C
27971C-----COMMON----------------------------------------------------------
27972C
27973      INCLUDE 'DPCOGR.INC'
27974      INCLUDE 'DPCONP.INC'
27975      INCLUDE 'DPCOBE.INC'
27976      INCLUDE 'DPCODV.INC'
27977      INCLUDE 'DPCOP2.INC'
27978C
27979C-----START POINT-----------------------------------------------------
27980C
27981      ISUBN0='SEPA'
27982      IERRG4='NO'
27983C
27984      NCSTR=(-999)
27985C
27986      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SEPA')THEN
27987        WRITE(ICOUT,999)
27988  999   FORMAT(1X)
27989        CALL DPWRST('XXX','BUG ')
27990        WRITE(ICOUT,51)
27991   51   FORMAT('***** AT THE BEGINNING OF GRSEPA--')
27992        CALL DPWRST('XXX','BUG ')
27993        WRITE(ICOUT,53)ICASE,IPATTT,JPATTT
27994   53   FORMAT('ICASE,IPATTT,JPATTT = ',2(A4,2X),I8)
27995        CALL DPWRST('XXX','BUG ')
27996        WRITE(ICOUT,54)PXSPA,PYSPA,PXSPA2,PYSPA2
27997   54   FORMAT('PXSPA,PYSPA,PXSPA2,PYSPA2 = ',4G15.7)
27998        CALL DPWRST('XXX','BUG ')
27999        WRITE(ICOUT,55)IHORPA,IVERPA,IDUPPA,IDDOPA
28000   55   FORMAT('IHORPA,IVERPA,IDUPPA,IDDOPA = ',3(A4,2X),A4)
28001        CALL DPWRST('XXX','BUG ')
28002        WRITE(ICOUT,58)IMANUF,IMODEL,IBUGG4,ISUBG4
28003   58   FORMAT('IMANUF,IMODEL,IBUGG4,ISUBG4 = ',3(A4,2X),A4)
28004        CALL DPWRST('XXX','BUG ')
28005      ENDIF
28006C
28007C               ********************************************
28008C               **  STEP 1--                              **
28009C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
28010C               **  AND THE MODEL                         **
28011C               ********************************************
28012C
28013      IF(IMANUF.EQ.'QWIN')THEN
28014        GOTO4700
28015      ELSEIF(IMANUF.EQ.'POST')THEN
28016        GOTO8600
28017      ELSEIF(IMANUF.EQ.'X11 ')THEN
28018        GOTO9600
28019      ELSEIF(IMANUF.EQ.'AQUA')THEN
28020        GOTO13500
28021      ELSEIF(IMANUF.EQ.'GENE')THEN
28022        IF(IMODEL.EQ.'CODE')GOTO3200
28023        IF(IMODEL.EQ.'CGM')GOTO3300
28024        IF(IMODEL.EQ.'CGMB')GOTO3400
28025        GOTO3100
28026      ELSEIF(IMANUF.EQ.'SVG ')THEN
28027        GOTO16000
28028      ELSEIF(IMANUF.EQ.'GD  ')THEN
28029        GOTO12000
28030      ELSEIF(IMANUF.EQ.'LATE')THEN
28031        GOTO15000
28032      ELSEIF(IMANUF.EQ.'CAIR')THEN
28033        GOTO17000
28034      ELSEIF(IMANUF.EQ.'D3  ')THEN
28035        GOTO19000
28036      ELSEIF(IMANUF.EQ.'WMF ')THEN
28037        GOTO18000
28038      ELSEIF(IMANUF.EQ.'OPGL')THEN
28039        GOTO4800
28040      ELSEIF(IMANUF.EQ.'TEKT')THEN
28041        IF(IMODEL.EQ.'4006')GOTO1400
28042        IF(IMODEL.EQ.'4010')GOTO1400
28043C
28044        IF(IMODEL.EQ.'4020')GOTO1200
28045        IF(IMODEL.EQ.'4022')GOTO1200
28046        IF(IMODEL.EQ.'4025')GOTO1200
28047        IF(IMODEL.EQ.'4027')GOTO1200
28048C
28049        IF(IMODEL.EQ.'4105')GOTO1300
28050        IF(IMODEL.EQ.'4107')GOTO1300
28051        IF(IMODEL.EQ.'4109')GOTO1300
28052        IF(IMODEL.EQ.'4115')GOTO1300
28053        IF(IMODEL.EQ.'4107')GOTO1300
28054        IF(IMODEL.EQ.'4113')GOTO1300
28055C
28056        GOTO1100
28057      ELSEIF(IMANUF.EQ.'HP')THEN
28058        IF(IMODEL.EQ.'7221')GOTO2100
28059        IF(IMODEL.EQ.'2622')GOTO2300
28060        IF(IMODEL.EQ.'2623')GOTO2300
28061        IF(IMODEL.EQ.'2627')GOTO2300
28062        IF(IMODEL.EQ.'2647')GOTO2300
28063        GOTO2200
28064      ELSEIF(IMANUF.EQ.'LIBP')THEN
28065        GOTO2600
28066      ELSEIF(IMANUF.EQ.'REGI')THEN
28067        GOTO8100
28068      ELSEIF(IMANUF.EQ.'GKS ')THEN
28069        GOTO11000
28070      ELSEIF(IMANUF.EQ.'LAHE')THEN
28071        IF(IMODEL.EQ.'INTE')GOTO4900
28072        IF(IMODEL.EQ.'WINT')GOTO4950
28073        GOTO4600
28074      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
28075        GOTO13000
28076      ELSEIF(IMANUF.EQ.'QUIC')THEN
28077        GOTO9100
28078      ELSEIF(IMANUF.EQ.'CALC')THEN
28079        GOTO4100
28080      ELSEIF(IMANUF.EQ.'ZETA')THEN
28081        GOTO5100
28082      ELSEIF(IMANUF.EQ.'TURB')THEN
28083        GOTO10000
28084      ELSEIF(IMANUF.EQ.'SUN ')THEN
28085        GOTO6600
28086      ENDIF
28087      GOTO9000
28088C
28089C               *******************************************
28090C               **  STEP 11--                            **
28091C               **  TREAT THE TEKTRONIX 4014             **
28092C               **  REFERENCE--40Z105 MANUAL, PAGE 5-52  **
28093C               *******************************************
28094C
28095 1100 CONTINUE
28096      IF(ICASE.EQ.'REGI')THEN
28097        GOTO9000
28098      ELSEIF(ICASE.EQ.'MARK')THEN
28099        GOTO9000
28100      ELSEIF(ICASE.EQ.'TEXT')THEN
28101        GOTO9000
28102      ELSE
28103CCCCC   ADD FOLLOWING LINE OCTOBER 1996
28104        IF(JPATTT.EQ.-1)GOTO9000
28105        CALL DPCONA(JPATTT,IPATTZ)
28106        ICSTR(1:1)=IESCC
28107        ICSTR(2:2)=IPATTZ
28108        NCSTR=2
28109        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
28110      ENDIF
28111      GOTO9000
28112C
28113C               **************************************************************
28114C               **  STEP 12--                                               **
28115C               **  TREAT THE TEKTRONIX 4027                                **
28116C               **  (COLOR RASTER DEVICE).                                  **
28117C               **  REFERENCE--XXX                                          **
28118C               **************************************************************
28119C
28120 1200 CONTINUE
28121C
28122      IF(ICASE.EQ.'LINE')THEN
28123        IF(JPATTT.EQ.-1)GOTO9000
28124        ICSTR(1:5)='!LIN '
28125        NCSTR=5
28126        NCHTOT=8
28127        CALL GRTRIN(JPATTT,NCHTOT,ICSTR,NCSTR)
28128        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
28129      ELSEIF(ICASE.EQ.'MARK')THEN
28130        GOTO9000
28131      ELSEIF(ICASE.EQ.'TEXT')THEN
28132        GOTO9000
28133      ELSE
28134        GOTO9000
28135      ENDIF
28136      GOTO9000
28137C
28138C               **************************************************************
28139C               **  STEP 13--                                               **
28140C               **  TREAT THE TEKTRONIX 4105                                **
28141C               **  (COLOR RASTER DEVICE).                                  **
28142C               **  REFERENCE--XXX                                          **
28143C               **************************************************************
28144C
28145 1300 CONTINUE
28146C
28147      IF(ICASE.EQ.'REGI')THEN
28148        GOTO9000
28149      ELSEIF(ICASE.EQ.'MARK')THEN
28150        GOTO9000
28151      ELSEIF(ICASE.EQ.'TEXT')THEN
28152        GOTO9000
28153      ELSE
28154        IF(JPATTT.EQ.-1)GOTO9000
28155        CALL DPCONA(JPATTT,IPATTZ)
28156        ICSTR(1:1)=IESCC
28157        ICSTR(2:2)=IPATTZ
28158        NCSTR=2
28159        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
28160      ENDIF
28161      GOTO9000
28162C
28163C               **********************************************************
28164C               **  STEP 14--                                           **
28165C               **  TREAT THE TEKTRONIX 4010 AND 4006                   **
28166C               **  (THEY HAVE ONLY SOLID LINES AND INCOMPLETE PLOT-10  **
28167C               **  REFERENCE--XXX                                      **
28168C               ***********************************************************
28169C
28170 1400 CONTINUE
28171CCCCC ADD FOLLOWING LINE OCTOBER 1996
28172      IF(JPATTT.EQ.-1)GOTO9000
28173      GOTO9000
28174C
28175C               ****************************************************
28176C               **  STEP 21--                                     **
28177C               **  TREAT THE HEWLETT-PACKARD 7221 CASE           **
28178C               **  (MULTI-COLOR PENPLOTTER)                      **
28179C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER          **
28180C               **             OPERATING AND PROGRAMMING MANUAL,  **
28181C               **             PAGE 258 AND 152.                  **
28182C               ****************************************************
28183C
28184 2100 CONTINUE
28185      IF(ICASE.EQ.'REGI')THEN
28186        GOTO9000
28187      ELSEIF(ICASE.EQ.'MARK')THEN
28188        GOTO9000
28189      ELSEIF(ICASE.EQ.'TEXT')THEN
28190        GOTO9000
28191      ELSE
28192        IF(IPATTT.EQ.'BLAN' .OR. IPATTT.EQ.'BL  ' .OR.
28193     1     IPATTT.EQ.'NONE' .OR. IPATTT.EQ.'NO  ' .OR.
28194     1     IPATTT.EQ.'    ')THEN
28195          ICSTR(1:9)='~Q @ @cH}'
28196          NCSTR=9
28197        ELSEIF(IPATTT.EQ.'SOLI' .OR. IPATTT.EQ.'SO  ')THEN
28198          ICSTR(1:3)='~Q}'
28199          NCSTR=3
28200        ELSEIF(IPATTT.EQ.'DOTT' .OR. IPATTT.EQ.'DOT ' .OR.
28201     1         IPATTT.EQ.'DO  ')THEN
28202          ICSTR(1:13)='~Q!A!A!A!Aa@}'
28203          NCSTR=13
28204        ELSEIF(IPATTT.EQ.'DASH' .OR. IPATTT.EQ.'DA  ')THEN
28205          ICSTR(1:9)='~Q"A"Aa@}'
28206          NCSTR=9
28207        ELSEIF(IPATTT.EQ.'DA1 ')THEN
28208          ICSTR(1:7)='~Q$Ba@}'
28209          NCSTR=7
28210        ELSEIF(IPATTT.EQ.'DA2 ')THEN
28211          ICSTR(1:9)='~Q#A!Aa@}'
28212          NCSTR=9
28213        ELSEIF(IPATTT.EQ.'DA3 ')THEN
28214          ICSTR(1:9)='~Q#A!Aa@}'
28215          NCSTR=9
28216        ELSEIF(IPATTT.EQ.'DA4 ')THEN
28217          ICSTR(1:9)='~Q#A!Aa@}'
28218          NCSTR=9
28219        ELSE
28220          ICSTR(1:3)='~Q}'
28221          NCSTR=3
28222        ENDIF
28223        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
28224      ENDIF
28225      GOTO9000
28226C
28227C               ******************************************************
28228C               **  STEP 22--                                       **
28229C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
28230C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
28231C               **  (MULTI-COLOR PENPLOTTERS)                       **
28232C               **  TO SET PATTERN--                                **
28233C               **  WRITE OUT A    LT     PATTERN NUMBER            **
28234C               **  (WITH A TRAILING SEMI-COLON WHICH IS THE        **
28235C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
28236C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
28237C               **             OPERATING AND PROGRAMMING MANUAL,    **
28238C               **             PAGE 100, 141.                       **
28239C               ******************************************************
28240C
28241 2200 CONTINUE
28242      IF(ICASE.EQ.'REGI')THEN
28243        GOTO9000
28244      ELSEIF(ICASE.EQ.'MARK')THEN
28245        GOTO9000
28246      ELSEIF(ICASE.EQ.'TEXT')THEN
28247        GOTO9000
28248      ELSE
28249        ICSTR(1:2)='LT'
28250        IF(JPATTT.GE.0)THEN
28251          NCSTR=2
28252          NCHTOT=1
28253          CALL GRTRIN(JPATTT,NCHTOT,ICSTR,NCSTR)
28254          ICSTR(4:4)=';'
28255          NCSTR=4
28256        ELSE
28257          ICSTR(3:3)=';'
28258          NCSTR=3
28259        ENDIF
28260        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
28261      ENDIF
28262      GOTO9000
28263C
28264C               **********************************************************
28265C               **  STEP 23--                                           **
28266C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
28267C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
28268C               **  (MONOCHROME DISPLAY TERMINALS)                      **
28269C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
28270C               **             REFERENCE MANUAL,                        **
28271C               **             PAGE 10-6, 10-7.                         **
28272C               **********************************************************
28273C
28274 2300 CONTINUE
28275      IF(ICASE.EQ.'REGI')THEN
28276        GOTO9000
28277      ELSEIF(ICASE.EQ.'MARK')THEN
28278        GOTO9000
28279      ELSEIF(ICASE.EQ.'TEXT')THEN
28280        GOTO9000
28281      ELSE
28282        ICSTR(1:1)=IESCC
28283        ICSTR(2:3)='*m'
28284        NCSTR=3
28285        NCHTOT=1
28286        IF(JPATTT.GT.9)NCHTOT=2
28287        CALL GRTRIN(JPATTT,NCHTOT,ICSTR,NCSTR)
28288        NCSTRT=NCSTR+1
28289        NCEND=NCSTR+2
28290        ICSTR(NCSTRT:NCEND)='bZ'
28291        NCSTR=NCEND
28292        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
28293      ENDIF
28294      GOTO9000
28295C
28296C               **********************************************************
28297C               **  STEP 26--                                           **
28298C               **  TREAT THE UNIX LIBPLOT            CASES             **
28299C               **********************************************************
28300C
28301 2600 CONTINUE
28302      IF(ICASE.EQ.'REGI')THEN
28303        GOTO9000
28304      ELSEIF(ICASE.EQ.'MARK')THEN
28305        GOTO9000
28306      ELSEIF(ICASE.EQ.'TEXT')THEN
28307        GOTO9000
28308      ELSE
28309C
28310C       FOR LINE, SET LINE PATTERN (AND ALSO SET CAP STYLE AND JOIN STYLE)
28311C
28312#ifdef HAVE_LIBPLOT
28313        INDEX=2
28314        ICODE=0
28315        AVAL=0.0
28316        IF(IPATTT.EQ.'SOLI')ICODE=0
28317        IF(IPATTT.EQ.'SO  ')ICODE=0
28318        IF(IPATTT.EQ.'DASH')ICODE=1
28319        IF(IPATTT.EQ.'DA  ')ICODE=1
28320        IF(IPATTT.EQ.'DOTT')ICODE=2
28321        IF(IPATTT.EQ.'DA2 ')ICODE=3
28322        IF(IPATTT.EQ.'DA3 ')ICODE=4
28323        IF(IPATTT.EQ.'DA4 ')ICODE=5
28324        IF(IPATTT.EQ.'DA5 ')ICODE=6
28325        CALL PLLATR(INDEX,ICODE,DBLE(AVAL))
28326        INDEX=3
28327        ICODE=0
28328        IF(ILPLCS.EQ.'BUTT')ICODE=0
28329        IF(ILPLCS.EQ.'ROUN')ICODE=1
28330        IF(ILPLCS.EQ.'PROJ')ICODE=2
28331        CALL PLLATR(INDEX,ICODE,DBLE(AVAL))
28332        INDEX=4
28333        ICODE=0
28334        IF(ILPLJS.EQ.'MITE')ICODE=0
28335        IF(ILPLJS.EQ.'ROUN')ICODE=1
28336        IF(ILPLJS.EQ.'BEVE')ICODE=2
28337        CALL PLLATR(INDEX,ICODE,DBLE(AVAL))
28338#endif
28339      ENDIF
28340      GOTO9000
28341C
28342C               ***************************************************
28343C               **  STEP 31--                                    **
28344C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE  **
28345C               ***************************************************
28346C
28347 3100 CONTINUE
28348      IF(ICASE.EQ.'LINE')THEN
28349        ICSTR(1:17)='SET PATTERN LINE '
28350        ICSTR(18:21)=IPATTT
28351        NCSTR=21
28352      ELSEIF(ICASE.EQ.'REGI')THEN
28353        ICSTR(1:19)='SET PATTERN REGION '
28354        ICSTR(20:24)=IPATTT
28355        NCSTR=24
28356      ELSEIF(ICASE.EQ.'MARK')THEN
28357        ICSTR(1:19)='SET PATTERN MARKER '
28358        ICSTR(20:24)=IPATTT
28359        NCSTR=24
28360      ELSEIF(ICASE.EQ.'TEXT')THEN
28361        ICSTR(1:17)='SET PATTERN TEXT '
28362        ICSTR(18:21)=IPATTT
28363        NCSTR=21
28364      ELSE
28365        GOTO9000
28366      ENDIF
28367      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
28368      GOTO9000
28369C
28370C               ***************************************************************
28371C               **  STEP 32--                                                **
28372C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
28373C               ***************************************************************
28374C
28375 3200 CONTINUE
28376      IF(ICASE.EQ.'LINE')THEN
28377        ICSTR(1:10)='SEPA LINE '
28378        ICSTR(11:14)=IPATTT
28379        NCSTR=14
28380      ELSEIF(ICASE.EQ.'REGI')THEN
28381        ICSTR(1:10)='SEPA REGI '
28382        ICSTR(11:14)=IPATTT
28383        NCSTR=14
28384      ELSEIF(ICASE.EQ.'MARK')THEN
28385        ICSTR(1:10)='SEPA MARK '
28386        ICSTR(11:14)=IPATTT
28387        NCSTR=14
28388      ELSEIF(ICASE.EQ.'TEXT')THEN
28389        ICSTR(1:10)='SEPA TEXT '
28390        ICSTR(11:14)=IPATTT
28391        NCSTR=14
28392      ELSE
28393        GOTO9000
28394      ENDIF
28395      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
28396      GOTO9000
28397C
28398C               ***************************************************************
28399C               **  STEP 33--                                                **
28400C               **  TREAT THE CGM                                CASE        **
28401C               ***************************************************************
28402C
28403 3300 CONTINUE
28404      IF(ICASE.EQ.'LINE')THEN
28405        ICSTR(1:9)='LINETYPE '
28406        NCHTOT=1
28407        NCSTR=9
28408        CALL GRTRIN(JPATTT,NCHTOT,ICSTR,NCSTR)
28409        ICSTR(11:11)=';'
28410        NCSTR=11
28411        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
28412      ELSEIF(ICASE.EQ.'REGI')THEN
28413        IF(IPATTT.EQ.'SOLI' .OR. IPATTT.EQ.'FILL')THEN
28414          ICSTR(1:15)='INTSTYLE SOLID;'
28415          NCSTR=15
28416          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
28417        ELSE
28418          ICSTR(1:15)='INTSTYLE HATCH;'
28419          NCSTR=15
28420          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
28421          ICSTR(1:11)='HATCHINDEX '
28422          NCHTOT=1
28423          NCSTR=11
28424          CALL GRTRIN(JPATTT,NCHTOT,ICSTR,NCSTR)
28425          ICSTR(13:13)=';'
28426          NCSTR=13
28427          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
28428        ENDIF
28429      ELSEIF(ICASE.EQ.'MARK')THEN
28430        GOTO9000
28431      ELSEIF(ICASE.EQ.'TEXT')THEN
28432        GOTO9000
28433      ELSE
28434        GOTO9000
28435      ENDIF
28436      GOTO9000
28437C
28438C               ***************************************************
28439C               **  STEP 34--                                    **
28440C               **  TREAT THE CGM (BINARY)                 CASE  **
28441C               ***************************************************
28442C
28443 3400 CONTINUE
28444      GOTO9000
28445C
28446C               ******************************************************
28447C               **  STEP 41--                                       **
28448C               **  TREAT THE CALCOMP XXXXXX CASE                   **
28449C               **  TO SET PATTERN--                                **
28450C               **  WRITE OUT AN XXXXXXXXXX                         **
28451C               **  (NOT DONE)                                      **
28452C               **  REFERENCE--CALCOMP ELECTROMECHANICAL PLOTTERS - **
28453C               **             PROGRAMMING, CALCOMP, 1987           **
28454C               **             PAGES 33 AND 34                      **
28455C               **  USE CALCOMP LIBRARY ROUTINE DASHS               **
28456C               **  SINCE THIS ROUTINE IS NOT SUPPORTED BY MANY     **
28457C               **  VERSIONS OF THE LIBRARY, COMMENT OUT.  SITES    **
28458C               **  CAN ACTIVATE IF DESIRED.                        **
28459C               **      CALL DASHS(ARRAY,ICNT)                      **
28460C               **  WHERE                                           **
28461C               **      ICNT=0   - TURN ON SOLID LINE               **
28462C               **      ICNT=2, ARRAY(1)=0.1, (2)=-0.1 - DEFAULT    **
28463C               **                 DASH PATTERN.                    **
28464C               **  ARRAY GIVES LENGTH OF ALTERNATING SOLID AND     **
28465C               **  SEGMENTS IN INCHES.  CURRENTLY ONLY DEFINE 1    **
28466C               **  DASH AND 1 DOTTED PATTERN                       **
28467C               ******************************************************
28468C
28469 4100 CONTINUE
28470      IF(ICASE.EQ.'REGI')THEN
28471        GOTO9000
28472      ELSEIF(ICASE.EQ.'MARK')THEN
28473        GOTO9000
28474      ELSEIF(ICASE.EQ.'TEXT')THEN
28475        GOTO9000
28476      ELSE
28477        IF(JPATTT.EQ.-1)GOTO9000
28478        IF(JPATTT.EQ.2)THEN
28479          ICNT=2
28480          ARRCAL(1)=0.05
28481          ARRCAL(2)=-0.05
28482        ELSEIF(JPATTT.EQ.1 .OR. JPATTT.GT.2)THEN
28483          ICNT=2
28484          ARRCAL(1)=0.1
28485          ARRCAL(2)=-0.1
28486        ELSE
28487          ARRCAL(1)=0.
28488          ARRCAL(2)=0.
28489          ICNT=0
28490        ENDIF
28491C
28492C       FOLLOWING LINE TO ACTIVATE CALCOMP DASHED LINES
28493C
28494#ifdef HAVE_CALCOMP
28495        CALL DASHS(ARRCAL,ICNT)
28496#endif
28497      ENDIF
28498      GOTO9000
28499C
28500C               ******************************************************
28501C               **  STEP 46--                                       **
28502C               **  TREAT THE LAHEY   XXXXXX CASE                   **
28503C               **  REFERENCE--Programmer's Reference, Revision C   **
28504C               **             Lahey Computer Systems, January, 1992**
28505C               **             PAGES 51 THRU 65                     **
28506C               ******************************************************
28507C
28508 4600 CONTINUE
28509      IF(ICASE.EQ.'REGI')THEN
28510        GOTO9000
28511      ELSEIF(ICASE.EQ.'MARK')THEN
28512        GOTO9000
28513      ELSEIF(ICASE.EQ.'TEXT')THEN
28514        GOTO9000
28515      ELSE
28516        GOTO9000
28517      ENDIF
28518      GOTO9000
28519C
28520C               ******************************************************
28521C               **  STEP 47--                                       **
28522C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
28523C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
28524C               ******************************************************
28525C
28526 4700 CONTINUE
28527#ifdef HAVE_QWIN
28528      IF(ICASE.EQ.'REGI')THEN
28529        GOTO9000
28530      ELSEIF(ICASE.EQ.'MARK')THEN
28531        GOTO9000
28532      ELSEIF(ICASE.EQ.'TEXT')THEN
28533        GOTO9000
28534      ELSE
28535        IF(IPATTT.EQ.'BLAN' .OR.  IPATTT.EQ.'BL  ' .OR.
28536     1     IPATTT.EQ.'NONE' .OR. IPATTT.EQ.'NO  ' .OR.
28537     1     IPATTT.EQ.'    ')THEN
28538           STYLE=#0000
28539        ELSEIF(IPATTT.EQ.'SOLI' .OR.  IPATTT.EQ.'SO  ')THEN
28540           STYLE=#FFFF
28541        ELSEIF(IPATTT.EQ.'DOTT' .OR. IPATTT.EQ.'DOT ' .OR.
28542     1     IPATTT.EQ.'DO  ')THEN
28543           STYLE=#AAAA
28544        ELSEIF(IPATTT.EQ.'DASH' .OR. IPATTT.EQ.'DA  ')THEN
28545           STYLE=#FF00
28546        ELSEIF(IPATTT.EQ.'DA1 ')THEN
28547           STYLE=#FF00
28548        ELSEIF(IPATTT.EQ.'DA2 ')THEN
28549           STYLE=#F0F0
28550        ELSEIF(IPATTT.EQ.'DA3 ')THEN
28551           STYLE=#3C3C
28552        ELSEIF(IPATTT.EQ.'DA4 ')THEN
28553           STYLE=#8888
28554        ELSE
28555           STYLE=#FFFF
28556        ENDIF
28557        CALL SETLINESTYLE(STYLE)
28558      ENDIF
28559#endif
28560      GOTO9000
28561C
28562C               ******************************************************
28563C               **  STEP 48--                                       **
28564C               **  TREAT THE OPEN-GL DRIVER                        **
28565C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
28566C               ******************************************************
28567C
28568 4800 CONTINUE
28569      IF(ICASE.EQ.'REGI')THEN
28570        GOTO9000
28571      ELSEIF(ICASE.EQ.'MARK')THEN
28572        GOTO9000
28573      ELSEIF(ICASE.EQ.'TEXT')THEN
28574        GOTO9000
28575      ELSE
28576        IF(IPATTT.EQ.'BLAN' .OR.  IPATTT.EQ.'BL  ' .OR.
28577     1     IPATTT.EQ.'NONE' .OR. IPATTT.EQ.'NO  ' .OR.
28578     1     IPATTT.EQ.'    ')THEN
28579        ELSEIF(IPATTT.EQ.'SOLI' .OR.  IPATTT.EQ.'SO  ')THEN
28580        ELSEIF(IPATTT.EQ.'DOTT' .OR. IPATTT.EQ.'DOT ' .OR.
28581     1         IPATTT.EQ.'DO  ')THEN
28582        ELSEIF(IPATTT.EQ.'DASH' .OR. IPATTT.EQ.'DA  ')THEN
28583        ELSEIF(IPATTT.EQ.'DA1 ')THEN
28584        ELSEIF(IPATTT.EQ.'DA2 ')THEN
28585        ELSEIF(IPATTT.EQ.'DA3 ')THEN
28586        ELSEIF(IPATTT.EQ.'DA4 ')THEN
28587        ELSE
28588        ENDIF
28589      ENDIF
28590      GOTO9000
28591C
28592C               ******************************************************
28593C               **  STEP 49--                                       **
28594C               **  TREAT THE LAHEY INTERACTOR CASE                 **
28595C               ******************************************************
28596C
28597 4900 CONTINUE
28598#ifdef HAVE_INTERACTER
28599      IF(ICASE.EQ.'REGI')THEN
28600        GOTO9000
28601      ELSEIF(ICASE.EQ.'MARK')THEN
28602        GOTO9000
28603      ELSEIF(ICASE.EQ.'TEXT')THEN
28604        GOTO9000
28605      ELSE
28606        IF(IPATTT.EQ.'BLAN' .OR.  IPATTT.EQ.'BL  ' .OR.
28607     1     IPATTT.EQ.'NONE' .OR. IPATTT.EQ.'NO  ' .OR.
28608     1     IPATTT.EQ.'    ')THEN
28609          CALL IGrLineType(0)
28610        ELSEIF(IPATTT.EQ.'SOLI' .OR.  IPATTT.EQ.'SO  ')THEN
28611          CALL IGrLineType(0)
28612        ELSEIF(IPATTT.EQ.'DOTT' .OR. IPATTT.EQ.'DOT ' .OR.
28613     1         IPATTT.EQ.'DO  ')THEN
28614          CALL IGrLineType(1)
28615        ELSEIF(IPATTT.EQ.'DASH' .OR. IPATTT.EQ.'DA  ')THEN
28616          CALL IGrLineType(2)
28617        ELSEIF(IPATTT.EQ.'DA1 ')THEN
28618          CALL IGrLineType(3)
28619        ELSEIF(IPATTT.EQ.'DA2 ')THEN
28620          CALL IGrLineType(4)
28621        ELSEIF(IPATTT.EQ.'DA3 ')THEN
28622          CALL IGrLineType(5)
28623        ELSEIF(IPATTT.EQ.'DA4 ')THEN
28624          CALL IGrLineType(6)
28625        ELSE
28626        ENDIF
28627      ENDIF
28628#endif
28629      GOTO9000
28630C
28631C               ******************************************************
28632C               **  STEP 49B-                                       **
28633C               **  TREAT THE LAHEY WINTERACTOR CASE                **
28634C               ******************************************************
28635C
28636 4950 CONTINUE
28637#ifdef HAVE_WININTERACTER
28638      IF(ICASE.EQ.'REGI')THEN
28639        GOTO9000
28640      ELSEIF(ICASE.EQ.'MARK')THEN
28641        GOTO9000
28642      ELSEIF(ICASE.EQ.'TEXT')THEN
28643        GOTO9000
28644      ELSE
28645        IF(IPATTT.EQ.'BLAN' .OR.  IPATTT.EQ.'BL  ' .OR.
28646     1     IPATTT.EQ.'NONE' .OR. IPATTT.EQ.'NO  ' .OR.
28647     1     IPATTT.EQ.'    ')THEN
28648          CALL IGrLineType(0)
28649        ELSEIF(IPATTT.EQ.'SOLI' .OR.  IPATTT.EQ.'SO  ')THEN
28650          CALL IGrLineType(0)
28651        ELSEIF(IPATTT.EQ.'DOTT' .OR. IPATTT.EQ.'DOT ' .OR.
28652     1         IPATTT.EQ.'DO  ')THEN
28653          CALL IGrLineType(1)
28654        ELSEIF(IPATTT.EQ.'DASH' .OR. IPATTT.EQ.'DA  ')THEN
28655          CALL IGrLineType(2)
28656        ELSEIF(IPATTT.EQ.'DA1 ')THEN
28657          CALL IGrLineType(3)
28658        ELSEIF(IPATTT.EQ.'DA2 ')THEN
28659          CALL IGrLineType(4)
28660        ELSEIF(IPATTT.EQ.'DA3 ')THEN
28661          CALL IGrLineType(5)
28662        ELSEIF(IPATTT.EQ.'DA4 ')THEN
28663          CALL IGrLineType(6)
28664        ELSE
28665        ENDIF
28666      ENDIF
28667#endif
28668      GOTO9000
28669C
28670C               ******************************************************
28671C               **  STEP 51--                                       **
28672C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
28673C               **  TO SET PATTERN--                                **
28674C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
28675C               **             MODELS 3600SX AND 3653SX             **
28676C               **             PAGES B-0 AND B-1                    **
28677C               **  USE ZETA VERSION OF CALCOMP LIBRARY.  VALUE OF  **
28678C               **  LINE PATTERN STORED IN DEVICE COMMON.  USED IN  **
28679C               **  VALUE OF "IPEN" SENT TO PLOT ROUTINE.  NOTHING  **
28680C               **  DONE IN THIS ROUTINE                            **
28681C               ******************************************************
28682C
28683 5100 CONTINUE
28684      IF(ICASE.EQ.'REGI')THEN
28685        GOTO9000
28686      ELSEIF(ICASE.EQ.'MARK')THEN
28687        GOTO9000
28688      ELSEIF(ICASE.EQ.'TEXT')THEN
28689        GOTO9000
28690      ELSE
28691        GOTO9000
28692      ENDIF
28693      GOTO9000
28694C
28695C               ******************************************************
28696C               **  STEP 66--                                       **
28697C               **  TREAT THE SUN CASE - WRITTEN BY BILL ANDERSON   **
28698C               ******************************************************
28699C
28700 6600 CONTINUE
28701#ifdef HAVE_SUN
28702      IF(ICASE.EQ.'TEXT')THEN
28703        GOTO9000
28704      ELSE
28705        IF(IPATTT.EQ.'BLAN' .OR. IPATTT.EQ.'BL  ' .OR.
28706     1     IPATTT.EQ.'NONE' .OR. IPATTT.EQ.'NO  ' .OR.
28707     1     IPATTT.EQ.'    ')GOTO9000
28708        IF(IPATTT.EQ.'SOLI' .OR. IPATTT.EQ.'SO  ')CALL cflntype(0)
28709        IF(IPATTT.EQ.'DOTT' .OR. IPATTT.EQ.'DOT ' .OR.
28710     1     IPATTT.EQ.'DO  ')CALL cflntype(1)
28711        IF(IPATTT.EQ.'DASH' .OR. IPATTT.EQ.'DA  ')CALL cflntype(2)
28712        IF(IPATTT.EQ.'DA1 ')CALL cflntype(3)
28713        IF(IPATTT.EQ.'DA2 ')CALL cflntype(4)
28714        IF(IPATTT.EQ.'DA3 ')CALL cflntype(5)
28715      ENDIF
28716#endif
28717      GOTO9000
28718C
28719C               ******************************************************
28720C               **  STEP 81--                                       **
28721C               **  TREAT THE DEC  REGIS CASE                       **
28722C               **  TO SET (LINE) PATTERN--                         **
28723C               **  WRITE OUT A    W(P     PATTERN NUMBER)          **
28724C               **  WHERE PATTERN NUMBER IS 0 TO 6.                 **
28725C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
28726C               **             PAGE 136                             **
28727C               ******************************************************
28728C
28729 8100 CONTINUE
28730      IF(ICASE.EQ.'REGI')THEN
28731        GOTO9000
28732      ELSEIF(ICASE.EQ.'MARK')THEN
28733        GOTO9000
28734      ELSEIF(ICASE.EQ.'TEXT')THEN
28735        GOTO9000
28736      ELSE
28737        ICSTR(1:3)='W(P'
28738        NCSTR=3
28739        NCHTOT=1
28740        CALL GRTRIN(JPATTT,NCHTOT,ICSTR,NCSTR)
28741        ICSTR(5:5)=')'
28742        NCSTR=5
28743        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
28744      ENDIF
28745      GOTO9000
28746C
28747C               ******************************************************
28748C               **  STEP 86--                                       **
28749C               **  TREAT THE POSTSCRIPT CASE                       **
28750C               **  TO SET (LINE) PATTERN--                         **
28751C               **  [ <X> <X> ...] <OFFSET> SETDASH                 **
28752C               **  THE FOLLOWING PATTERNS ARE USED, BUT THEY ARE   **
28753C               **  SCALED TO THE DOTS PER INCH (PATTERNS ARE FOR   **
28754C               **  72 DOTS PER INCH)                               **
28755C               **  [ 0 4 ] 0                                       **
28756C               **  [ ] 0                                           **
28757C               **  [ 2 4 ] 0                                       **
28758C               **  [ 4 4 ] 0                                       **
28759C               **  [ 4 2 ] 0                                       **
28760C               **  [ 6 4 2 4 ] 0                                   **
28761C               **  [ 6 4 4 4 ] 0                                   **
28762C               **  [ 6 4 4 4 2 4 ] 0                               **
28763C               **  REFERENCE--POSTSCRIPT LANGUAGE, TUTORIAL AND    **
28764C               **             COOKBOOK, ADOBE SYSTEMS              **
28765C               ******************************************************
28766CCCCC JUNE, 1990.  BUG FIX.  POSTSCRIPT DOES NOT SUPPORT A "NULL" LINE
28767CCCCC PATTERN.  SET TO SOLID, BUT IN GRDRPL, IF PATTERN IS ZERO, SKIP
28768CCCCC THE LINE.
28769C
28770 8600 CONTINUE
28771      IF(ICASE.EQ.'REGI')THEN
28772        GOTO9000
28773      ELSEIF(ICASE.EQ.'MARK')THEN
28774        GOTO9000
28775      ELSEIF(ICASE.EQ.'TEXT')THEN
28776        GOTO9000
28777      ELSE
28778        ASCALE=PSTPPI/72.
28779        IF(JPATTT.EQ.1)THEN
28780          ICSTR(1:13)='[ ] 0 setdash'
28781          NCSTR=13
28782        ELSEIF(JPATTT.EQ.2)THEN
28783          ICSTR(1:2)='[ '
28784          NCHTOT=5
28785          NCSTR=2
28786          IJUNK=INT(2.*ASCALE+0.5)
28787          IF(IJUNK.LE.1)IJUNK=2
28788          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28789          ICSTR(8:8)=' '
28790          NCSTR=8
28791          IJUNK=INT(4.*ASCALE+0.5)
28792          IF(IJUNK.LE.1)IJUNK=4
28793          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28794          ICSTR(14:25)=' ] 0 setdash'
28795          NCSTR=25
28796        ELSEIF(JPATTT.EQ.3)THEN
28797          ICSTR(1:2)='[ '
28798          NCHTOT=5
28799          NCSTR=2
28800          IJUNK=INT(4.*ASCALE+0.5)
28801          IF(IJUNK.LE.1)IJUNK=4
28802          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28803          ICSTR(8:8)=' '
28804          NCSTR=8
28805          IJUNK=INT(4.*ASCALE+0.5)
28806          IF(IJUNK.LE.1)IJUNK=4
28807          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28808          ICSTR(14:25)=' ] 0 setdash'
28809          NCSTR=25
28810        ELSEIF(JPATTT.EQ.4)THEN
28811          ICSTR(1:2)='[ '
28812          NCHTOT=5
28813          NCSTR=2
28814          IJUNK=INT(4.*ASCALE+0.5)
28815          IF(IJUNK.LE.1)IJUNK=4
28816          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28817          ICSTR(8:8)=' '
28818          NCSTR=8
28819          IJUNK=INT(2.*ASCALE+0.5)
28820          IF(IJUNK.LE.1)IJUNK=2
28821          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28822          ICSTR(14:25)=' ] 0 setdash'
28823          NCSTR=25
28824        ELSEIF(JPATTT.EQ.5)THEN
28825          ICSTR(1:2)='[ '
28826          NCHTOT=5
28827          NCSTR=2
28828          IJUNK=INT(6.*ASCALE+0.5)
28829          IF(IJUNK.LE.1)IJUNK=6
28830          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28831          ICSTR(8:8)=' '
28832          NCSTR=8
28833          IJUNK=INT(4.*ASCALE+0.5)
28834          IF(IJUNK.LE.1)IJUNK=4
28835          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28836          ICSTR(14:14)=' '
28837          NCSTR=14
28838          IJUNK=INT(2.*ASCALE+0.5)
28839          IF(IJUNK.LE.1)IJUNK=2
28840          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28841          ICSTR(20:20)=' '
28842          NCSTR=20
28843          IJUNK=INT(4.*ASCALE+0.5)
28844          IF(IJUNK.LE.1)IJUNK=4
28845          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28846          ICSTR(26:37)=' ] 0 setdash'
28847          NCSTR=37
28848        ELSEIF(JPATTT.EQ.6)THEN
28849          ICSTR(1:2)='[ '
28850          NCHTOT=5
28851          NCSTR=2
28852          IJUNK=INT(6.*ASCALE+0.5)
28853          IF(IJUNK.LE.1)IJUNK=6
28854          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28855          ICSTR(8:8)=' '
28856          NCSTR=8
28857          IJUNK=INT(4.*ASCALE+0.5)
28858          IF(IJUNK.LE.1)IJUNK=4
28859          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28860          ICSTR(14:14)=' '
28861          NCSTR=14
28862          IJUNK=INT(6.*ASCALE+0.5)
28863          IF(IJUNK.LE.1)IJUNK=6
28864          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28865          ICSTR(20:20)=' '
28866          NCSTR=20
28867          IJUNK=INT(4.*ASCALE+0.5)
28868          IF(IJUNK.LE.1)IJUNK=4
28869          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28870          ICSTR(26:37)=' ] 0 setdash'
28871          NCSTR=37
28872        ELSEIF(JPATTT.EQ.7)THEN
28873          ICSTR(1:2)='[ '
28874          NCHTOT=5
28875          NCSTR=2
28876          IJUNK=INT(6.*ASCALE+0.5)
28877          IF(IJUNK.LE.1)IJUNK=6
28878          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28879          ICSTR(8:8)=' '
28880          NCSTR=8
28881          IJUNK=INT(4.*ASCALE+0.5)
28882          IF(IJUNK.LE.1)IJUNK=4
28883          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28884          ICSTR(14:14)=' '
28885          NCSTR=14
28886          IJUNK=INT(4.*ASCALE+0.5)
28887          IF(IJUNK.LE.1)IJUNK=4
28888          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28889          ICSTR(20:20)=' '
28890          NCSTR=20
28891          IJUNK=INT(4.*ASCALE+0.5)
28892          IF(IJUNK.LE.1)IJUNK=4
28893          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28894          ICSTR(26:26)=' '
28895          NCSTR=26
28896          IJUNK=INT(2.*ASCALE+0.5)
28897          IF(IJUNK.LE.1)IJUNK=2
28898          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28899          ICSTR(32:32)=' '
28900          NCSTR=32
28901          IJUNK=INT(4.*ASCALE+0.5)
28902          IF(IJUNK.LE.1)IJUNK=4
28903          CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR)
28904          ICSTR(38:49)=' ] 0 setdash'
28905          NCSTR=49
28906        ELSE
28907          ICSTR(1:13)='[ ] 0 setdash'
28908          NCSTR=13
28909        ENDIF
28910        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
28911      ENDIF
28912      GOTO9000
28913C
28914C               ******************************************************
28915C               **  STEP 91--                                       **
28916C               **  TREAT THE QUIC       CASE                       **
28917C               **  TO SET (LINE) PATTERN--                         **
28918C               **  WRITE OUT A    ^V(PATTERN NUMBER)               **
28919C               **  HOWEVER, SET WHEN ACTUALLY DRAW LINE            **
28920C               **  WHERE PATTERN NUMBER IS 0 TO 9, A-F             **
28921C               **  REFERENCE--QUIC PROGRAMMERS MANUAL, FROM QMS    **
28922C               **             CHAPTER 14                           **
28923C               ******************************************************
28924C
28925 9100 CONTINUE
28926      IF(ICASE.EQ.'REGI')THEN
28927        GOTO9000
28928      ELSEIF(ICASE.EQ.'MARK')THEN
28929        GOTO9000
28930      ELSEIF(ICASE.EQ.'TEXT')THEN
28931        GOTO9000
28932      ELSE
28933        GOTO9000
28934      ENDIF
28935      GOTO9000
28936C
28937C               ******************************************************
28938C               **  STEP 96--                                       **
28939C               **  TREAT THE X11        CASE                       **
28940C               ******************************************************
28941C
28942 9600 CONTINUE
28943#ifdef HAVE_X11
28944      IF(IX11OF.EQ.'OFF')GOTO9000
28945      IF(ICASE.EQ.'REGI')THEN
28946        GOTO9000
28947      ELSEIF(ICASE.EQ.'MARK')THEN
28948        GOTO9000
28949      ELSEIF(ICASE.EQ.'TEXT')THEN
28950        GOTO9000
28951      ELSE
28952        IF(JPATTT.EQ.-1)GOTO9000
28953        ICODE=3
28954        INDEX=0
28955        IF(IX11CS.EQ.'ROUND')INDEX=1
28956        IF(IX11CS.EQ.'NOTLAST')INDEX=2
28957        IF(IX11CS.EQ.'PROJECT')INDEX=3
28958        CALL XLATTR(INDEX,ICODE)
28959        ICODE=4
28960        INDEX=0
28961        IF(IX11JS.EQ.'ROUND')INDEX=1
28962        IF(IX11JS.EQ.'BEVEL')INDEX=2
28963        CALL XLATTR(INDEX,ICODE)
28964        ICODE=2
28965        INDEX=0
28966        CALL XLATTR(JPATTT,ICODE)
28967      ENDIF
28968#endif
28969      GOTO9000
28970C
28971C               *************************************************
28972C               **  STEP 100--                                 **
28973C               **  TREAT THE VGA VIA TURBO-C       CASE       **
28974C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
28975C               **             ENHANCEMENTS, PAGE 74.          **
28976C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
28977C               **             PAGE 310.                       **
28978C               **  REFERENCE--WEISKAMP, POWER GRAPHICS        **
28979C               **             USING TURBO C, PAGE 29.         **
28980C               *************************************************
28981C
2898210000 CONTINUE
28983      IF(ITCST.EQ.'CLOS')GOTO9000
28984CCCCC ADD FOLLOWING LINE OCTOBER 1996
28985      IF(JPATTT.EQ.-1)GOTO9000
28986CTURB CALL TCSEPA(ICASE,IPATTT)
28987      GOTO9000
28988C
28989C               ******************************************************
28990C               **  STEP 110--                                      **
28991C               **  TREAT THE GKS                DRIVER             **
28992C               ******************************************************
28993C
2899411000 CONTINUE
28995      IF(ICASE.EQ.'REGI')THEN
28996        GOTO9000
28997      ELSEIF(ICASE.EQ.'MARK')THEN
28998        GOTO9000
28999      ELSEIF(ICASE.EQ.'TEXT')THEN
29000        GOTO9000
29001      ELSE
29002        IF(JPATTT.EQ.-1)GOTO9000
29003#ifdef HAVE_GKS
29004        CALL GSLN(JPATTT)
29005#endif
29006      ENDIF
29007      GOTO9000
29008C
29009C               ******************************************************
29010C               **  STEP 120--                                      **
29011C               **  TREAT THE GD                     DRIVER         **
29012C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
29013C               **  1) JPEG                                         **
29014C               **  2) PNG                                          **
29015C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
29016C               ******************************************************
29017C
2901812000 CONTINUE
29019#ifdef HAVE_GD
29020      IF(ICASE.EQ.'REGI')THEN
29021        GOTO9000
29022      ELSEIF(ICASE.EQ.'MARK')THEN
29023        GOTO9000
29024      ELSEIF(ICASE.EQ.'TEXT')THEN
29025        GOTO9000
29026      ELSE
29027CCCCC   CALL GDSEPA(JPATTT)
29028      ENDIF
29029#endif
29030      GOTO9000
29031C
29032C               ******************************************************
29033C               **  STEP 130--                                      **
29034C               **  TREAT THE ABSOFT                 DRIVER         **
29035C               ******************************************************
29036C
2903713000 CONTINUE
29038      IF(ICASE.EQ.'REGI')THEN
29039        GOTO9000
29040      ELSEIF(ICASE.EQ.'MARK')THEN
29041        GOTO9000
29042      ELSEIF(ICASE.EQ.'TEXT')THEN
29043        GOTO9000
29044      ELSE
29045        IF(JPATTT.EQ.-1)GOTO9000
29046        GOTO9000
29047      ENDIF
29048      GOTO9000
29049C
29050C               ******************************************************
29051C               **  STEP 135--                                      **
29052C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
29053C               ******************************************************
29054C
2905513500 CONTINUE
29056      IF(ICASE.EQ.'REGI')THEN
29057        GOTO9000
29058      ELSEIF(ICASE.EQ.'MARK')THEN
29059        GOTO9000
29060      ELSEIF(ICASE.EQ.'TEXT')THEN
29061        GOTO9000
29062      ELSE
29063        IF(JPATTT.EQ.-1)GOTO9000
29064        IOPT=1
29065        PTHICK=-1.0
29066C
29067        NPATT=0
29068        DO13511I=1,8
29069          XPATT(1)=0.0
2907013511 CONTINUE
29071        IF(JPATTT.EQ.2)THEN
29072          NPATT=2
29073          XPATT(1)=4.0
29074          XPATT(2)=2.0
29075        ELSEIF(JPATTT.EQ.3)THEN
29076          NPATT=2
29077          XPATT(1)=1.0
29078          XPATT(2)=2.0
29079        ELSEIF(JPATTT.EQ.4)THEN
29080          NPATT=4
29081          XPATT(1)=4.0
29082          XPATT(2)=2.0
29083          XPATT(3)=1.0
29084          XPATT(4)=2.0
29085        ELSEIF(JPATTT.EQ.5)THEN
29086          NPATT=2
29087          XPATT(1)=6.0
29088          XPATT(2)=2.0
29089        ELSEIF(JPATTT.EQ.6)THEN
29090          NPATT=4
29091          XPATT(1)=6.0
29092          XPATT(2)=2.0
29093          XPATT(3)=1.0
29094          XPATT(4)=2.0
29095        ELSEIF(JPATTT.EQ.7)THEN
29096          NPATT=2
29097          XPATT(1)=8.0
29098          XPATT(2)=4.0
29099        ELSEIF(JPATTT.EQ.8)THEN
29100          NPATT=4
29101          XPATT(1)=8.0
29102          XPATT(2)=4.0
29103          XPATT(3)=1.0
29104          XPATT(4)=2.0
29105        ENDIF
29106C
29107#ifdef HAVE_AQUA
29108        CALL aqsepa(XPATT,NPATT,PTHICK,IOPT)
29109#endif
29110      ENDIF
29111      GOTO9000
29112C
29113C               ******************************************************
29114C               **  STEP 150--                                      **
29115C               **  TREAT THE LATEK (USING EEPIC)            DRIVER **
29116C               ******************************************************
29117C
2911815000 CONTINUE
29119      IF(ICASE.EQ.'REGI')THEN
29120        GOTO9000
29121      ELSEIF(ICASE.EQ.'MARK')THEN
29122        GOTO9000
29123      ELSEIF(ICASE.EQ.'TEXT')THEN
29124        GOTO9000
29125      ELSE
29126        GOTO9000
29127      ENDIF
29128      GOTO9000
29129C
29130C               ******************************************************
29131C               **  STEP 160--                                      **
29132C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
29133C               ******************************************************
29134C
2913516000 CONTINUE
29136      IF(ICASE.EQ.'REGI')THEN
29137        GOTO9000
29138      ELSEIF(ICASE.EQ.'MARK')THEN
29139        GOTO9000
29140      ELSEIF(ICASE.EQ.'TEXT')THEN
29141        GOTO9000
29142      ELSE
29143        GOTO9000
29144      ENDIF
29145      GOTO9000
29146C
29147C               ******************************************************
29148C               **  STEP 170--                                      **
29149C               **  TREAT THE CAIRO                          DRIVER **
29150C               ******************************************************
29151C
2915217000 CONTINUE
29153      GOTO9000
29154C
29155C               ******************************************************
29156C               **  STEP 180--                                      **
29157C               **  TREAT THE WMF                            DRIVER **
29158C               ******************************************************
29159C
2916018000 CONTINUE
29161      GOTO9000
29162C
29163C               ******************************************************
29164C               **  STEP 190--                                      **
29165C               **  TREAT THE D3                             DRIVER **
29166C               ******************************************************
29167C
2916819000 CONTINUE
29169      GOTO9000
29170C
29171C               *****************
29172C               **  STEP 90--  **
29173C               **  EXIT       **
29174C               *****************
29175C
29176 9000 CONTINUE
29177      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SEPA')THEN
29178        WRITE(ICOUT,999)
29179        CALL DPWRST('XXX','BUG ')
29180        WRITE(ICOUT,9011)
29181 9011   FORMAT('***** AT THE END       OF GRSEPA--')
29182        CALL DPWRST('XXX','BUG ')
29183        WRITE(ICOUT,9023)JPATTT,NCSTR,IERRG4
29184 9023   FORMAT('NCSTR,JPATTT,IERRG4 = ',2I8,2X,A4)
29185        CALL DPWRST('XXX','BUG ')
29186        IF(NCSTR.GT.0)THEN
29187          DO9025I=1,NCSTR
29188            CALL DPCOAN(ICSTR(I:I),IASCNE)
29189            WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
29190 9026       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
29191            CALL DPWRST('XXX','BUG ')
29192 9025     CONTINUE
29193        ENDIF
29194      ENDIF
29195C
29196      RETURN
29197      END
29198      SUBROUTINE GRSEPP(I,
29199     1                  IDMANU,IDMODE,IDMOD2,IDMOD3,
29200     1                  IDPOWE,IDCONT,IDCOLO,IDFONT,IDNVPP,IDNHPP,
29201     1                  IDUNIT,IDNVOF,IDNHOF,
29202     1                  IBUGO2,IFOUN2,IERROR)
29203C
29204C     PURPOSE--SCAN FOR PARTICULAR MANUFACTURERS FOR DEVICE I, AND
29205C              APPROPRIATELY UPDATE THE CONTINUITY, COLOR, AND PICTURE
29206C              POINT VECTORS.
29207C     NOTE--MANY OF THE PICTURE POINT SETTINGS HAVE BEEN ASSIGNED
29208C           VALUES OF 1000 AND 1000--THIS INDICATES THAT THE
29209C           ACTUAL COORECT VALUES ARE NOT KNOWN AND SHOULD
29210C           BE ASSIGNED THE PROPER VALUE IF SUCH A DEVICE
29211C           EXISTS AT ONE'S INSTALLATION.
29212C     INPUT  ARGUMENTS--I
29213C                     --IDMANU
29214C                     --IDMODE
29215C                     --IDMOD2
29216C                     --IDMOD3
29217C     OUTPUT ARGUMENTS--IDPOWE
29218C                     --IDCONT
29219C                     --IDCOLO
29220C                     --IDNVPP
29221C                     --IDNHPP
29222C                     --IFOUN2 ('YES' OR 'NO' )
29223C                     --IERROR ('YES' OR 'NO' )
29224C     WRITTEN BY--JAMES J. FILLIBEN
29225C                 STATISTICAL ENGINEERING DIVISION
29226C                 INFORMATION TECHNOLOGY LABORATORY
29227C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
29228C                 GAITHERSBURG, MD 20899-8980
29229C                 PHONE--301-975-2855
29230C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
29231C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
29232C     LANGUAGE--ANSI FORTRAN (1977)
29233C     VERSION NUMBER--82/7
29234C     ORIGINAL VERSION--OCTOBER   1980.
29235C     UPDATED         --MAY       1982.
29236C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
29237C                                      DRIVER OBSOLETE
29238C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
29239C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
29240C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
29241C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
29242C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
29243C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
29244C     UPDATED         --MARCH    1990. EMULATE ORIENTATION FOR SOME
29245C                                      DEVICES (BY ALAN HECKERT)
29246C     UPDATED         --MAY      1990. HP-GL UPDATES (BY ALAN HECKERT)
29247C     UPDATED         --NOVEMBER 1990. POSTSCRIPT BUG FIX (BY ALAN HECKERT)
29248C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
29249C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
29250C                                      DRIVER OBSOLETE
29251C     UPDATED         --AUGUST   1992. HP-GL FOR LASERJET III (ALAN)
29252C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
29253C                                      OLD CALCOMP STYLE
29254C                                      DRIVER OBSOLETE
29255C     UPDATED         --OCTOBER  1996. QUICKWIN (ALAN)
29256C     UPDATED         --OCTOBER  1996. OPEN GL (ALAN)
29257C                                      USE BILL MITCHELLS OPENGL
29258C                                      BINDING FOR FORTRAN
29259C     UPDATED         --OCTOBER  1996. GKS (ALAN)
29260C                                      CODED, NOT TESTED
29261C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
29262C                                      PLACEHOLDER FOR NOW
29263C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
29264C                                      PLACEHOLDER FOR NOW
29265C     UPDATED         --NOVEMBER 1996. SUPPORT FOR
29266C                                      "LANDSCAPE WORDPERFECT"
29267C                                      FOR POSTSCRIPT DRIVER
29268C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
29269C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
29270C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
29271C     UPDATED         --JUNE     2000. MACINTOSH
29272C                                      PLACEHOLDER FOR NOW
29273C                                      CHANGE THIS TO "QUARTZ"
29274C     UPDATED         --JUNE     2000. PC PRINTER
29275C                                      PLACEHOLDER FOR NOW
29276C                                      CHANGE THIS TO "GHOSTSCRIPT"
29277C     UPDATED         --MARCH    2002. ADD LATEX (EEPIC)
29278C     UPDATED         --MARCH    2002. ADD SVG (SCALABLE VECTOR GRAPHICS)
29279C     UPDATED         --JANUARY  2003. SUPPORT FOR ORIENTATION WHEN DEVICE
29280C                                      IS INITIALIZED.
29281C     UPDATED         --JANUARY  2003. SUPPORT FOR LANDSCAPE WORDPERFECT
29282C                                      ORIENTATION FOR POSTSCRIPT AND
29283C                                      OTHER DEVICES
29284C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM DEVICE
29285C                                      USED WITH MAC OSX
29286C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
29287C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
29288C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
29289C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
29290C     UPDATED         --OCTOBER  2016. REMOVE THE "TERMINAL" DEVICES AS
29291C                                      THESE DO NOT SUPPORT GRAPHICS
29292C     UPDATED         --DECEMBER 2019. CHECK FEEDBACK SETTING FOR OUTPUT
29293C                                      MESSAGES
29294C
29295C---------------------------------------------------------------------
29296C
29297      CHARACTER*4 IDMANU
29298      CHARACTER*4 IDMODE
29299      CHARACTER*4 IDMOD2
29300      CHARACTER*4 IDMOD3
29301C
29302      CHARACTER*4 IDPOWE
29303      CHARACTER*4 IDCONT
29304      CHARACTER*4 IDCOLO
29305      CHARACTER*4 IDFONT
29306C
29307      CHARACTER*4 IC4
29308      CHARACTER*2 IC2
29309C
29310      CHARACTER*4 IBUGO2
29311      CHARACTER*4 IFOUN2
29312      CHARACTER*4 IERROR
29313C
29314C---------------------------------------------------------------------
29315C
29316      DIMENSION IDMANU(*)
29317      DIMENSION IDMODE(*)
29318      DIMENSION IDMOD2(*)
29319      DIMENSION IDMOD3(*)
29320C
29321      DIMENSION IDPOWE(*)
29322      DIMENSION IDCONT(*)
29323      DIMENSION IDCOLO(*)
29324      DIMENSION IDFONT(*)
29325      DIMENSION IDNVPP(*)
29326      DIMENSION IDNHPP(*)
29327      DIMENSION IDUNIT(*)
29328C
29329C  MAY, 1988.  ADD VERTICAL AND HORIZONTAL OFFSET PARAMETERS.
29330C
29331      DIMENSION IDNVOF(*)
29332      DIMENSION IDNHOF(*)
29333C
29334C---------------------------------------------------------------------
29335C
29336      INCLUDE 'DPCOST.INC'
29337      INCLUDE 'DPCODV.INC'
29338C
29339C  MAY, 1988. ADD "GRAPHICS UNIT" FROM "DPCOGR" COMMON BLOCKS.
29340C
29341      COMMON/ICOMGU/IGUNIT,IPRGR,IRDGR
29342C
29343      INCLUDE 'DPCOPA.INC'
29344      INCLUDE 'DPCOF2.INC'
29345      INCLUDE 'DPCOP2.INC'
29346C
29347C-----START POINT-----------------------------------------------------
29348C
29349      IFOUN2='NO'
29350      IERROR='NO'
29351C
29352      IF(IBUGO2.EQ.'ON')THEN
29353        WRITE(ICOUT,11)
29354   11   FORMAT('AT THE BEGINNING OF GRSEPP')
29355        CALL DPWRST('XXX','BUG ')
29356      ENDIF
29357C
29358      IDPOWE(I)='ON'
29359      IDFONT(I)='OFF'
29360C
29361C  MAY, 1988.  SEPARATE UNITS FOR GRAPHICS.
29362CCCCC IDUNIT(I)=IPR
29363      IDUNIT(I)=IPRGR
29364      IF(I.EQ.2)IDUNIT(I)=IPL1NU
29365      IF(I.EQ.3)IDUNIT(I)=IPL2NU
29366C
29367C     ******************************************************************
29368C     **  FOLLOWING ARE EITHER ALPHANUMERIC TERMINALS OR LINE PRINTERS**
29369C     ******************************************************************
29370C
29371C               *******************************
29372C               **  TREAT THE BATCH CASE     **
29373C               **  TREAT THE DISCRETE CASE  **
29374C               **  TREAT THE TERMINAL CASE  **
29375C               *******************************
29376C
29377      IF(IDMANU(I).EQ.'BATC')THEN
29378        IDCONT(I)='OFF'
29379        IDCOLO(I)='OFF'
29380        IDNHPP(I)=132
29381        IDNVPP(I)=66
29382        IDNVOF(I)=0
29383        IDNHOF(I)=0
29384        GOTO8919
29385      ELSEIF(IDMANU(I).EQ.'DISC')THEN
29386        IDCONT(I)='OFF'
29387        IDCOLO(I)='OFF'
29388        IDNHPP(I)=72
29389        IDNVPP(I)=24
29390        IF(IDMODE(I).EQ.'WIDE')IDNHPP(I)=132
29391        IF(IDMODE(I).EQ.'WIDE')IDNVPP(I)=66
29392        IDNVOF(I)=0
29393        IDNHOF(I)=0
29394        GOTO8919
29395      ELSEIF(IDMANU(I).EQ.'TERM')THEN
29396        IDCONT(I)='OFF'
29397        IDCOLO(I)='OFF'
29398        IDNHPP(I)=132
29399        IDNVPP(I)=66
29400        IDNVOF(I)=0
29401        IDNHOF(I)=0
29402        GOTO8919
29403      ENDIF
29404C
29405C     ******************************************************************
29406C     **  FOLLOWING ARE METAFILES                                     **
29407C     **  (GENERAL, GENERAL CODED, METAFILE, FILE, CGM)               **
29408C     ******************************************************************
29409C
29410      IF(IDMANU(I).EQ.'FILE' .OR. IDMANU(I).EQ.'META' .OR.
29411     1   IDMANU(I).EQ.'GENE' .OR. IDMANU(I).EQ.'CGM'  .OR.
29412     1   IDMANU(I).EQ.'CGMB')THEN
29413        IDCONT(I)='ON'
29414        IDCOLO(I)='ON'
29415        IDNHPP(I)=10000
29416        IDNVPP(I)=10000
29417        IF(IDMANU(I).EQ.'CGM')IDMODE(I)='CGM'
29418        IF(IDMANU(I).EQ.'CGM')IDMANU(I)='GENE'
29419        IF(IDMANU(I).EQ.'CGMB')IDMODE(I)='CGMB'
29420        IF(IDMANU(I).EQ.'CGMB')IDMANU(I)='GENE'
29421        IDNVOF(I)=0
29422        IDNHOF(I)=0
29423        GOTO8919
29424      ENDIF
29425C
29426C     ******************************************************************
29427C     **  FOLLOWING ARE CURRENTLY SUPPORTED DEVICES                   **
29428C     **                                                              **
29429C     **  1) TEKTRONIX   - (MODELS 4006, 4010, 4020, 4022, 4025, 4027 **
29430C     **                           4051, 4052, 4113, 4115, 4662, 4105 **
29431C     **                           4107, 4109, 4014, 4114)            **
29432C     **  2) HP          - HP-GL (9872, 7475, 7580)                   **
29433C     **                 -         7221 PLOTTER                       **
29434C     **                 -         2622 AND COMPATIBLE                **
29435C     **                           (2623, 2647, 2648, 9816, 9836,     **
29436C     **                                 2393, [MONOCHROME MODELS]    **
29437C     **                           2627, 2397, 2390 [8 COLORS])       **
29438C     **  3) CALCOMP     - REQUIRES LOCAL VERSION OF CALCOMP LIBRARY  **
29439C     **  4) ZETA        - REQUIRES LOCAL VERSION OF ZETA (A CALCOMP  **
29440C     **                   EXTENDED LIBRARY)                          **
29441C     **  5) REGIS       - ANY DEC TERMINAL RUNNING REGIS PROTOCOL    **
29442C     **  6) SUN         - USES SUN GRAPHICS LIBRARY                  **
29443C     **                   CODE IN DATAPLOT GRAPHICS ROUTINES NEEDS   **
29444C     **                   TO BE UNCOMMENTED)                         **
29445C     **  7) QUIC        - (EITHER LANDSCAPE OR PORTRAIT MODE)        **
29446C     **  8) POSTSCRIPT  - (EITHER LANDSCAPE OR PORTRAIT MODE)        **
29447C     **  9) X11         - (PICTURE POINTS CAN VARY)                  **
29448C     **  9) VGA/TURBO-C - REQUIRES TURBO-C 2.0 OR ABOVE              **
29449C     ** 10) LAHEY       - REQUIRES LAHEY COMPILER AND GRAPHICS LIB   **
29450C     ** 11) QWIN        - REQUIRES MICROSOFT COMPILER                **
29451C     ** 12) GKS         - REQUIRES A GKS LIBRARY                     **
29452C     ** 13) OPGL        - REQUIRES BILL MITCHELLS OPENGL             **
29453C     **                   FORTRAN 90 BINDING                         **
29454C     ** 14) GD          - REQUIRES GD LIBRARY                        **
29455C     **                   (JPEG, PNG, WINDOWS BMP)                   **
29456C     ** 15) LIBPLOT     - UNIX LIBPLOT LIBRARY                       **
29457C     ** 16) LATEX (EEPIC) - LATEX (USING EEPIC PACKAGE)              **
29458C     ** 17) ABSOFT      - ABSOFT DRIVER                              **
29459C     ** 18) SVG         - SCALABLE VECTOR GRAPHICS                   **
29460C     ** 19) AQUATERM    - AQUATERM                                   **
29461C     ******************************************************************
29462C
29463      IF(IDMANU(I).EQ.'HEWL' .OR. IDMANU(I).EQ.'HP')THEN
29464C
29465C       TREAT THE HEWLETT PACKARD CASE
29466C       REFERENCE--7221T OPERATING AND PROGRAMMING MANUAL, PAGE 78
29467C       (FOR 2622 AND 2623) PAGE 10-1
29468C
29469C       UPDATED MAY, 1990 FOR HP-GL.  ADD CHECK FOR MODEL NUMBER:
29470C       UPDATED AUGUST 1992.  CHECK FOR LASERJET III MODEL (TREAT AS 7475
29471C       BUT IS MONOCHROME, ADVANCE PAGE HANDLED SEPARATELY)
29472C       9872              - (4 PENS, 1 PAPER SIZE)
29473C       7475, 7550        - (8 PENS, 2 PAPER SIZES)
29474C       7580              - (8 PENS, 4 PAPER SIZES)
29475C       7585, 7586        - (8 PENS, 5 PAPER SIZES)
29476C       LJET, LASE, LJ    - (1 PEN, 1 PAPER SIZE)
29477C
29478C       FOLLOWING ANSI STANDARD PAPER SIZES RECOGNIZED:
29479C
29480C       A  - 8 1/2 X 11
29481C       B  - 11    X 17
29482C       C  - 17    X 22
29483C       D  - 22    X 34
29484C       E  - 34    X 44
29485C
29486C       NOTE THAT FOR HP-GL, THE "IP" POINTS DEFINE THE "SCALE" POINTS WHILE
29487C       THE "SC" POINTS DEFINE THE USER UNITS.  THAT IS, THE LOWER LEFT CORNER
29488C       SPECIFIED BY SC IS MAPPED TO THE LOWER LEFT SCALING POINT AND THE UPPER
29489C       RIGHT CORNER SPECIFIED BY SC IS MAPPED TO THE UPPER RIGHT SCALING POINT.
29490C       THAT IS, THE IP AND SC COMMANDS DEFINE THE WINDOW-TO-VIEWPORT MAPPING.
29491C       DATAPLOT DOES NOT SPECIFY THE IP PARAMETER BECAUSE MOST HP-GL PLOTTERS
29492C       ALLOW A USER TO MANUALLY SET THESE FROM THE PLOTTER AND WE DO NOT WANT
29493C       TO OVERIDE IF THEY HAVE SET IT.  WE SET THE SC PARAMETERS EQUAL TO THE
29494C       DEFAULT IP VALUES FOR THE GIVEN PLOTTER AND PAPER SIZE (EXCEPT FOR THE
29495C       7580/85/86 PLOTTERS WHICH USE NEGATIVE VALUES, FOR THESE WE DOUBLE THE
29496C       POSITIVE DISTANCE).  THIS MEANS WE PLOT IN ABSOLUTE PLOTTER UNITS.  WE
29497C       DO THIS SINCE DATAPLOT TYPICALLY WORKS IN "PICTURE POINT" UNITS ANYWAY
29498C       WHEN IT GETS TO THE DEVICE LEVEL.
29499C
29500C       UPDATED JULY, 1990 FOR HP 26XX MODELS.  SUPPORT COLOR ON SOME MODELS.
29501C
29502C       MODEL      RESOLUTION       COLORS
29503C       =====      ==========       ======
29504C       2622       512 X 390          0
29505C       2623       512 X 390          0
29506C       2647       720 X 360          0
29507C       2648       720 X 360          0
29508C       2393       512 X 390          0
29509C       9816       512 X 390          0
29510C       9836       512 X 390          0
29511C       2627       512 X 390          8
29512C       2397       512 X 390          8
29513C       2390       512 X 390          8
29514C
29515C       THESE MODELS ALL USE THE SAME DEVICE DRIVER.  THEY DIFFER ONLY IN
29516C       THE NUMBER OF PICTURE POINTS AND IN WHETHER THEY SUPPORT COLOR OR
29517C       NOT.
29518C
29519        IDCONT(I)='ON'
29520        IDCOLO(I)='ON'
29521        IDNHPP(I)=16158
29522        IDNVPP(I)=11040
29523        IDNVOF(I)=0
29524        IDNHOF(I)=0
29525        IC4=IDMODE(I)
29526        IC2=IC4(1:2)
29527        IF(IDMODE(I).EQ.'2627'.OR.IDMODE(I).EQ.'2397'.OR.
29528     1     IDMODE(I).EQ.'2390')THEN
29529          IDNHPP(I)=512
29530          IDNVPP(I)=390
29531          IDCOLO(I)='ON'
29532          IDMODE(I)='2622'
29533        ELSE IF(IDMODE(I).EQ.'2647'.OR.IDMODE(I).EQ.'2648')THEN
29534          IDNHPP(I)=720
29535          IDNVPP(I)=360
29536          IDCOLO(I)='OFF'
29537          IDMODE(I)='2622'
29538        ELSE IF(IDMODE(I).EQ.'9816'.OR.IDMODE(I).EQ.'9836'.OR.
29539     1          IDMODE(I).EQ.'2393'.OR.IDMODE(I).EQ.'2622'.OR.
29540     1          IDMODE(I).EQ.'2623'.OR.IDMODE(I).EQ.'216'.OR.
29541     1          IDMODE(I).EQ.'236'.OR. IC2.EQ.'26')THEN
29542          IDNHPP(I)=512
29543          IDNVPP(I)=390
29544          IDCOLO(I)='OFF'
29545          IDMODE(I)='2622'
29546        END IF
29547        IF(IDMODE(I).EQ.'7221')IDNHPP(I)=3040
29548        IF(IDMODE(I).EQ.'7221')IDNVPP(I)=2000
29549        IF(IDMOD2(I).EQ.'7550')IDMOD2(I)='7475'
29550        IF(IDMOD2(I).EQ.'7586')IDMOD2(I)='7585'
29551        IF(IDMOD2(I).EQ.'LJET' .OR. IDMOD2(I).EQ.'LJ  ' .OR.
29552     1     IDMOD2(I).EQ.'LASE')THEN
29553          IDMOD3(I)='LJET'
29554          IDMOD2(I)='7475'
29555        ENDIF
29556        IF(IDMODE(I).EQ.'2622'.AND.IDNHPP(I).EQ.512)THEN
29557          IF(IORNSW.EQ.'PORT')THEN
29558            IDNHPP(I)=302
29559            IDNHOF(I)=45
29560          ELSE IF(IORNSW.EQ.'SQUA')THEN
29561            IDNHPP(I)=390
29562            IDNHOF(I)=60
29563          END IF
29564        ELSE IF(IDMODE(I).EQ.'2622'.AND.IDNHPP(I).EQ.720)THEN
29565          IF(IORNSW.EQ.'PORT')THEN
29566            IDNHPP(I)=278
29567            IDNHOF(I)=221
29568          ELSE IF(IORNSW.EQ.'SQUA')THEN
29569            IDNHPP(I)=369
29570            IDNHOF(I)=180
29571          ELSE IF(IORNSW.EQ.'LAND')THEN
29572            IDNHPP(I)=466
29573            IDNHOF(I)=127
29574          END IF
29575        ELSE IF(IDMODE(I).EQ.'GL  ')THEN
29576          IGUNIT=IDUNIT(I)
29577          IF(IDMOD2(I).EQ.'7475')THEN
29578            IHPGCL=8
29579            IF(IDMOD3(I).EQ.'B   ')THEN
29580              IDNHPP(I)=16640
29581              IDNVPP(I)=10365
29582            ELSEIF(IDMOD3(I).EQ.'LJET')THEN
29583              IHPGCL=1
29584              IDNHPP(I)=10250
29585              IDNVPP(I)=7796
29586            ELSE
29587              IDNHPP(I)=10250
29588              IDNVPP(I)=7796
29589            END IF
29590          ELSE IF(IDMOD2(I).EQ.'7580')THEN
29591            IHPGCL=8
29592            IF(IDMOD3(I).EQ.'B   ')THEN
29593              IDNHPP(I)=14200
29594              IDNVPP(I)=9000
29595            ELSE IF(IDMOD3(I).EQ.'C   ')THEN
29596              IDNHPP(I)=19280
29597              IDNVPP(I)=16566
29598            ELSE IF(IDMOD3(I).EQ.'D   ')THEN
29599              IDNHPP(I)=20120
29600              IDNVPP(I)=30340
29601            ELSE
29602              IDNHPP(I)=5580
29603              IDNVPP(I)=9000
29604            END IF
29605          ELSE IF(IDMOD2(I).EQ.'7585')THEN
29606            IHPGCL=8
29607            IF(IDMOD3(I).EQ.'B   ')THEN
29608              IDNHPP(I)=14200
29609              IDNVPP(I)=9000
29610            ELSE IF(IDMOD3(I).EQ.'C   ')THEN
29611              IDNHPP(I)=14180
29612              IDNVPP(I)=20150
29613            ELSE IF(IDMOD3(I).EQ.'D   ')THEN
29614              IDNHPP(I)=20120
29615              IDNVPP(I)=30340
29616            ELSE IF(IDMOD3(I).EQ.'E   ')THEN
29617              IDNHPP(I)=41680
29618              IDNVPP(I)=32360
29619            ELSE
29620              IDNHPP(I)=5580
29621              IDNVPP(I)=9000
29622            END IF
29623          ELSE
29624            IHPGCL=4
29625            IDMOD2(I)='9872'
29626            IDNHPP(I)=16158
29627            IDNVPP(I)=11040
29628          END IF
29629          IHPGX=IDNHPP(I)
29630          IHPGY=IDNVPP(I)
29631          IF(IORNSW.EQ.'PORT')THEN
29632            ASPECT=8.5/11.
29633          ELSE IF(IORNSW.EQ.'SQUA')THEN
29634            ASPECT=1.
29635          ELSE IF(IORNSW.EQ.'LAND')THEN
29636            ASPECT=11./8.5
29637          ELSE
29638            ASPECT=-1.0
29639          END IF
29640          IF(ASPECT.GT.0.0)THEN
29641            IXMIN=0
29642            IXMAX=IDNHPP(I)
29643            IYMIN=0
29644            IYMAX=IDNVPP(I)
29645            XDIST=REAL(IXMAX-IXMIN+1)
29646            YDIST=REAL(IYMAX-IYMIN+1)
29647            XSIZE=YDIST*ASPECT
29648            IF(XSIZE.GT.REAL(IXMAX))XSIZE=REAL(IXMAX)
29649            XOFF=(XDIST-XSIZE)/2.
29650            IF(XOFF.LT.0.)XOFF=0.
29651            IDNHPP(I)=INT(XSIZE+0.5)
29652            IDNHOF(I)=INT(XOFF+0.5)
29653          END IF
29654        END IF
29655        IF(IHPGCL.LE.4)THEN
29656          IHPGPM(1)='BLACK'
29657          IHPGPM(2)='RED '
29658          IHPGPM(3)='BLUE'
29659          IHPGPM(4)='GREEN'
29660          DO6050J=5,16
29661          ITEMP=MOD(J-1,4)+1
29662          IHPGPM(J)=IHPGPM(ITEMP)
29663 6050     CONTINUE
29664        ELSE
29665          IHPGPM(1)='BLACK'
29666          IHPGPM(2)='RED '
29667          IHPGPM(3)='BLUE'
29668          IHPGPM(4)='GREEN'
29669          IHPGPM(5)='MAGENTA'
29670          IHPGPM(6)='ORANGE'
29671          IHPGPM(7)='CYAN'
29672          IHPGPM(8)='YELLOW'
29673          DO6060J=9,16
29674            ITEMP=J-8
29675            IHPGPM(J)=IHPGPM(ITEMP)
29676 6060     CONTINUE
29677        END IF
29678        IF(IFEEDB.EQ.'ON')THEN
29679          WRITE(ICOUT,999)
29680  999     FORMAT(1X)
29681          CALL DPWRST('XXX','BUG ')
29682          IF(IDMODE(I).EQ.'2622')THEN
29683            WRITE(ICOUT,6021)
29684 6021       FORMAT('HEWLETT-PACKARD 26XX-TYPE TERMINAL')
29685            CALL DPWRST('XXX','BUG ')
29686            WRITE(ICOUT,6022)
29687 6022       FORMAT('INCLUDING 981X, 983X, 21X, 23X TERMINALS')
29688            CALL DPWRST('XXX','BUG ')
29689            GOTO6090
29690          ELSEIF(IDMODE(I).EQ.'7221')THEN
29691            WRITE(ICOUT,6001)
29692 6001       FORMAT('HEWLETT-PACKARD 7221T')
29693            CALL DPWRST('XXX','BUG ')
29694          ELSE
29695            WRITE(ICOUT,6002)
29696 6002       FORMAT('HEWLETT-PACKARD WITH HP-GL')
29697            CALL DPWRST('XXX','BUG ')
29698          ENDIF
29699          WRITE(ICOUT,6010)
29700 6010     FORMAT('PEN SETTINGS--')
29701          CALL DPWRST('XXX','BUG ')
29702C
29703          IF(IDMODE(I).NE.'7221')THEN
29704            DO6079J=1,IHPGCL
29705              WRITE(ICOUT,6072)J,IHPGPM(J)
29706 6072         FORMAT('PEN ',I2,' = ',A8,'(3 MM)')
29707              CALL DPWRST('XXX','BUG ')
29708 6079       CONTINUE
29709          ELSE
29710            WRITE(ICOUT,6011)
29711 6011       FORMAT(12X,'PEN 1 = BLACK (3 MM)')
29712            CALL DPWRST('XXX','BUG ')
29713            WRITE(ICOUT,6012)
29714 6012       FORMAT(12X,'PEN 2 = RED   (3 MM)')
29715            CALL DPWRST('XXX','BUG ')
29716            WRITE(ICOUT,6013)
29717 6013       FORMAT(12X,'PEN 3 = BLUE  (3 MM)')
29718            CALL DPWRST('XXX','BUG ')
29719            WRITE(ICOUT,6014)
29720 6014       FORMAT(12X,'PEN 4 = GREEN (3 MM)')
29721            CALL DPWRST('XXX','BUG ')
29722          ENDIF
29723        ENDIF
29724C
29725 6090   CONTINUE
29726        GOTO8900
29727      ELSEIF(IDMANU(I).EQ.'TEKT')THEN
29728        IDCONT(I)='ON'
29729        IDCOLO(I)='OFF'
29730        IF(IDMODE(I).EQ.'4027')IDCOLO(I)='ON'
29731        IF(IDMODE(I).EQ.'4105')IDCOLO(I)='ON'
29732        IF(IDMODE(I).EQ.'4107')IDCOLO(I)='ON'
29733        IF(IDMODE(I).EQ.'4109')IDCOLO(I)='ON'
29734        IF(IDMODE(I).EQ.'4115')IDCOLO(I)='ON'
29735        IF(IDMODE(I).EQ.'4107')IDCOLO(I)='ON'
29736        IF(IDMODE(I).EQ.'4109')IDCOLO(I)='ON'
29737        IF(IDMODE(I).EQ.'4113')IDCOLO(I)='ON'
29738        IF(IDMODE(I).EQ.'4115')IDCOLO(I)='ON'
29739        IF(IDMODE(I).EQ.'4662')IDCOLO(I)='ON'
29740C
29741        IDNHPP(I)=4096
29742        IDNVPP(I)=3124
29743        IF(IDMODE(I).EQ.'4006')IDNHPP(I)=1024
29744        IF(IDMODE(I).EQ.'4006')IDNVPP(I)=781
29745        IF(IDMODE(I).EQ.'4010')IDNHPP(I)=1024
29746        IF(IDMODE(I).EQ.'4010')IDNVPP(I)=781
29747        IF(IDMODE(I).EQ.'4020')IDNHPP(I)=640
29748        IF(IDMODE(I).EQ.'4020')IDNVPP(I)=480
29749        IF(IDMODE(I).EQ.'4022')IDNHPP(I)=640
29750        IF(IDMODE(I).EQ.'4022')IDNVPP(I)=480
29751        IF(IDMODE(I).EQ.'4025')IDNHPP(I)=640
29752        IF(IDMODE(I).EQ.'4025')IDNVPP(I)=480
29753        IF(IDMODE(I).EQ.'4027')IDNHPP(I)=640
29754        IF(IDMODE(I).EQ.'4027')IDNVPP(I)=480
29755        IF(IDMODE(I).EQ.'4051')IDNHPP(I)=1024
29756        IF(IDMODE(I).EQ.'4051')IDNVPP(I)=781
29757        IF(IDMODE(I).EQ.'4052')IDNHPP(I)=1024
29758        IF(IDMODE(I).EQ.'4052')IDNVPP(I)=781
29759        IF(IDMODE(I).EQ.'4113')IDNHPP(I)=1000
29760        IF(IDMODE(I).EQ.'4113')IDNVPP(I)=800
29761        IF(IDMODE(I).EQ.'4115')IDNHPP(I)=1000
29762        IF(IDMODE(I).EQ.'4115')IDNVPP(I)=800
29763        IDNVOF(I)=0
29764        IDNHOF(I)=0
29765        IF(IDNHPP(I).EQ.4096)THEN
29766          IF(IORNSW.EQ.'PORT')THEN
29767            IDNHPP(I)=2414
29768            IDNHOF(I)=841
29769          ELSE IF(IORNSW.EQ.'SQUA')THEN
29770            IDNHPP(I)=3124
29771            IDNHOF(I)=486
29772          END IF
29773        ELSE IF(IDNHPP(I).EQ.1024)THEN
29774          IF(IORNSW.EQ.'PORT')THEN
29775            IDNHPP(I)=603
29776            IDNHOF(I)=89
29777          ELSE IF(IORNSW.EQ.'SQUA')THEN
29778            IDNHPP(I)=781
29779            IDNHOF(I)=121
29780          END IF
29781        ELSE IF(IDNHPP(I).EQ.640)THEN
29782          IF(IORNSW.EQ.'PORT')THEN
29783            IDNHPP(I)=371
29784            IDNHOF(I)=54
29785          ELSE IF(IORNSW.EQ.'SQUA')THEN
29786            IDNHPP(I)=480
29787            IDNHOF(I)=80
29788          END IF
29789        ELSE IF(IDNHPP(I).EQ.1000)THEN
29790          IF(IORNSW.EQ.'PORT')THEN
29791            IDNHPP(I)=618
29792            IDNHOF(I)=191
29793          ELSE IF(IORNSW.EQ.'SQUA')THEN
29794            IDNHPP(I)=800
29795            IDNHOF(I)=100
29796          END IF
29797        END IF
29798        IF(IDMODE(I).EQ.'4662' .AND. IFEEDB.EQ.'ON')THEN
29799          WRITE(ICOUT,999)
29800          CALL DPWRST('XXX','BUG ')
29801          WRITE(ICOUT,6411)
29802 6411     FORMAT('TEKTRONIX 4662 MULTI-PEN PLOTTER')
29803          CALL DPWRST('XXX','BUG ')
29804          WRITE(ICOUT,6412)
29805 6412     FORMAT('PEN SETTINGS--')
29806          CALL DPWRST('XXX','BUG ')
29807          WRITE(ICOUT,6413)
29808 6413     FORMAT(12X,'PEN 1 = BLACK (3.5 MM)')
29809          CALL DPWRST('XXX','BUG ')
29810          WRITE(ICOUT,6414)
29811 6414     FORMAT(12X,'PEN 2 = RED   (3.5 MM)')
29812          CALL DPWRST('XXX','BUG ')
29813          WRITE(ICOUT,6415)
29814 6415     FORMAT(12X,'PEN 3 = BLUE  (3.5 MM)')
29815          CALL DPWRST('XXX','BUG ')
29816          WRITE(ICOUT,6416)
29817 6416     FORMAT(12X,'PEN 4 = GREEN (3.5 MM)')
29818          CALL DPWRST('XXX','BUG ')
29819        ENDIF
29820        GOTO8919
29821      ELSEIF(IDMANU(I).EQ.'ZETA')THEN
29822        IDCONT(I)='ON'
29823        IDCOLO(I)='OFF'
29824        IF(IZETCL.GT.0)IDCOLO(I)='ON'
29825        IDNHPP(I)=INT(1000.*11.)
29826        IDNVPP(I)=INT(1000.*8.5)
29827        IDNVOF(I)=0
29828        IDNHOF(I)=0
29829        IF(IORNSW.EQ.'PORT')THEN
29830          IDNHPP(I)=INT(1000.*8.5)
29831          IDNVPP(I)=INT(1000.*11.)
29832          IDNVOF(I)=0
29833          IDNHOF(I)=0
29834        ELSEIF(IORNSW.EQ.'SQUA')THEN
29835          IDNHPP(I)=INT(1000.*8.5)
29836          IDNVPP(I)=INT(1000.*8.5)
29837          IDNVOF(I)=0
29838          IDNHOF(I)=0
29839        ELSEIF(IORNSW.EQ.'LAN2')THEN
29840          IDNHPP(I)=INT(1000.*8.5)
29841          IDNVPP(I)=INT(1000.*11.)
29842          IDNVOF(I)=INT(1000.*((11.0-7.73)/2))
29843          IDNHOF(I)=0
29844        ELSEIF(IORNSW.EQ.'POST')THEN
29845          IDNHPP(I)=INT(1000.*30.)
29846          IDNVPP(I)=INT(1000.*30.)
29847          IDNVOF(I)=0
29848          IDNHOF(I)=0
29849        ENDIF
29850        GOTO8900
29851      ELSEIF(IDMANU(I).EQ.'CALC')THEN
29852        IDCONT(I)='ON'
29853        IDCOLO(I)='OFF'
29854        IF(ICALCL.GT.0)IDCOLO(I)='ON'
29855        IDNHPP(I)=INT(1000.*11.)
29856        IDNVPP(I)=INT(1000.*8.5)
29857        IDNVOF(I)=0
29858        IDNHOF(I)=0
29859        IF(IORNSW.EQ.'PORT')THEN
29860          IDNHPP(I)=INT(1000.*8.5)
29861          IDNVPP(I)=INT(1000.*11.)
29862          IDNVOF(I)=0
29863          IDNHOF(I)=0
29864        ELSEIF(IORNSW.EQ.'SQUA')THEN
29865          IDNHPP(I)=INT(1000.*8.5)
29866          IDNVPP(I)=INT(1000.*8.5)
29867          IDNVOF(I)=0
29868          IDNHOF(I)=0
29869        ELSEIF(IORNSW.EQ.'LAN2')THEN
29870          IDNHPP(I)=INT(1000.*8.5)
29871          IDNVPP(I)=INT(1000.*11.)
29872          IDNVOF(I)=INT(1000.*((11.0-7.73)/2))
29873          IDNHOF(I)=0
29874        ELSEIF(IORNSW.EQ.'POST')THEN
29875          IDNHPP(I)=INT(1000.*30.)
29876          IDNVPP(I)=INT(1000.*30.)
29877          IDNVOF(I)=0
29878          IDNHOF(I)=0
29879        ENDIF
29880        GOTO8900
29881      ELSEIF(IDMANU(I).EQ.'REGI' .OR.  IDMANU(I).EQ.'VT' .OR.
29882     1       IDMANU(I).EQ.'DEC')THEN
29883        IDCONT(I)='ON'
29884        IDCOLO(I)='OFF'
29885        IDNHPP(I)=768
29886        IDNVPP(I)=480
29887        IDNVOF(I)=0
29888        IDNHOF(I)=0
29889        IF(IORNSW.EQ.'PORT')THEN
29890          IDNHPP(I)=371
29891          IDNHOF(I)=198
29892        ELSE IF(IORNSW.EQ.'SQUA')THEN
29893          IDNHPP(I)=480
29894          IDNHOF(I)=144
29895        ELSE IF(IORNSW.EQ.'LAND')THEN
29896          IDNHPP(I)=621
29897          IDNHOF(I)=73
29898        ELSE IF(IORNSW.EQ.'LAN2')THEN
29899          IDNHPP(I)=621
29900          IDNHOF(I)=73
29901        END IF
29902        IF(IFEEDB.EQ.'ON')THEN
29903          WRITE(ICOUT,999)
29904          CALL DPWRST('XXX','BUG ')
29905          WRITE(ICOUT,7102)
29906 7102     FORMAT('DEC WITH REGIS')
29907          CALL DPWRST('XXX','BUG ')
29908        ENDIF
29909        GOTO8900
29910      ELSEIF(IDMANU(I).EQ.'SUN')THEN
29911        IDCONT(I)='ON'
29912        IDCOLO(I)='OFF'
29913        IDUMMY=0
29914#ifdef HAVE_SUN
29915        CALL isitcolor(IDUMMY)
29916#endif
29917        ISUNCL=IDUMMY
29918        IF(ISUNCL.GT.0)IDCOLO(I)='ON'
29919        IDNHPP(I)=10000
29920        IDNVPP(I)=10000
29921        IDNVOF(I)=0
29922        IDNHOF(I)=0
29923        GOTO8900
29924      ELSEIF(IDMANU(I).EQ.'LIBP')THEN
29925C
29926C       UNIX LIBPLOT   CASE
29927C       BY DEFAULT, BITMAP DEVICES WILL BE SET TO
29928C       570x570 (THIS IS THE LIBPLTO DEFAULT)
29929C
29930        IDCONT(I)='ON'
29931        IDCOLO(I)='ON'
29932        IDNHPP(I)=570
29933        IDNVPP(I)=570
29934        IDNVOF(I)=0
29935        IDNHOF(I)=0
29936        GOTO8900
29937      ELSEIF(IDMANU(I).EQ.'QUIC' .OR. IDMANU(I).EQ.'QMS')THEN
29938        IDCONT(I)='ON'
29939        IDCOLO(I)='OFF'
29940        IDNHPP(I)=INT(11.*QUIPPI)-(IQUILM+IQUIRM)
29941        IDNVPP(I)=INT(8.5*QUIPPI)-(IQUITM+IQUIBM)
29942        IF(IORNSW.EQ.'PORT')IDNHPP(I)=INT(8.5*QUIPPI)-(IQU2LM+IQU2RM)
29943        IF(IORNSW.EQ.'PORT')IDNVPP(I)=INT(11.*QUIPPI)-(IQU2TM+IQU2BM)
29944        IDNVOF(I)=IQUITM
29945        IDNHOF(I)=IQUILM
29946        IF(IORNSW.EQ.'PORT')IDNVOF(I)=IQU2TM
29947        IF(IORNSW.EQ.'PORT')IDNHOF(I)=IQU2LM
29948        GOTO8900
29949      ELSEIF(IDMANU(I).EQ.'POST')THEN
29950        IDCONT(I)='ON'
29951        IDCOLO(I)='OFF'
29952        IF(IPSTDC.EQ.'ON')IDCOLO(I)='ON'
29953        IDNHPP(I)=INT(11.*PSTPPI)-(IPSTLM+IPSTRM)
29954        IDNVPP(I)=INT(8.5*PSTPPI)-(IPSTTM+IPSTBM)
29955        IF(IORNSW.EQ.'PORT')THEN
29956          IDNHPP(I)=INT(8.5*PSTPPI)-(IPS2LM+IPS2RM)
29957          IDNVPP(I)=INT(11.*PSTPPI)-(IPS2TM+IPS2BM)
29958        ELSEIF(IORNSW.EQ.'LAN2')THEN
29959          IDNHPP(I)=INT(8.5*PSTPPI)-(IPSTLM+IPSTRM)
29960          IDNVPP(I)=INT(6.5*PSTPPI)-(IPSTTM+IPSTBM)
29961        ELSEIF(IORNSW.EQ.'SQUA')THEN
29962          IDNHPP(I)=INT(8.5*PSTPPI)-(IPSTLM+IPSTRM)
29963          IDNVPP(I)=INT(8.5*PSTPPI)-(IPSTTM+IPSTBM)
29964        ENDIF
29965        IDNVOF(I)=0
29966        IDNHOF(I)=0
29967        GOTO8919
29968      ELSEIF(IDMANU(I).EQ.'X11 ')THEN
29969C
29970C       TREAT THE X11        CASE
29971C       ACTUAL PICTURE POINTS CAN VARY (BOTH BECAUSE
29972C       DIFFERENT WORKSTATIONS SUPPORTED AND BECAUSE
29973C       RESIDENT WINDOW MANAGER CAN MODIFY REQUESTED
29974C       PICTURE POINTS.  SET TO 0 HERE (THE X11 C LIBRARY
29975C       DEFAULT VALUES.  USER CAN SPECIFY A
29976C       SUGGESTED SIZE VIA DEVICE .. PICTURE POINTS.
29977C       THE X11 C LIBRARY WILL QUERY THE COLOR
29978C       CAPABILITY OF THE SPECIFIC WORKSTATION.
29979C
29980        IDCONT(I)='ON'
29981        IDCOLO(I)='ON'
29982        IDNHPP(I)=0
29983        IDNVPP(I)=0
29984        IDNVOF(I)=0
29985        IDNHOF(I)=0
29986        GOTO8900
29987      ELSEIF(IDMANU(I).EQ.'TURB')THEN
29988C
29989C       TREAT THE VGA VIA TURBO-C       CASE
29990C       REFERENCE--TURBO C 1.5 ADDITIONS &
29991C       ENHANCEMENTS, PAGE 105.
29992C       REFERENCE--TURBO C 2.0 REFERENCE GUIDE,
29993C       PAGE 200.
29994C
29995        IDCONT(I)='ON'
29996        IDCOLO(I)='ON'
29997        IDNHPP(I)=640
29998        IDNVPP(I)=480
29999        IDNVOF(I)=0
30000        IDNHOF(I)=0
30001        IF(IFEEDB.EQ.'ON')THEN
30002          WRITE(ICOUT,999)
30003          CALL DPWRST('XXX','BUG ')
30004          WRITE(ICOUT,7702)
30005 7702     FORMAT('TURBO-C/VGA')
30006          CALL DPWRST('XXX','BUG ')
30007        ENDIF
30008        GOTO8900
30009      ELSEIF(IDMANU(I).EQ.'LAHE')THEN
30010        IDCONT(I)='ON'
30011        IDCOLO(I)='OFF'
30012        IF(ILAHNC.GT.0)IDCOLO(I)='ON'
30013        IF(IORNSW.EQ.'PORT')THEN
30014          IF(IDMODE(I).EQ.'WINT'.OR.IDMODE(I).EQ.'INTE')THEN
30015            IDNHPP(I)=450
30016            IDNVPP(I)=600
30017          ELSE
30018            IDNHPP(I)=INT(1000.*8.5)
30019            IDNVPP(I)=INT(1000.*11.)
30020          ENDIF
30021        ELSEIF(IORNSW.EQ.'SQUA')THEN
30022          IF(IDMODE(I).EQ.'WINT'.OR.IDMODE(I).EQ.'INTE')THEN
30023            IDNHPP(I)=450
30024            IDNVPP(I)=450
30025          ELSE
30026            IDNHPP(I)=INT(1000.*8.5)
30027            IDNVPP(I)=INT(1000.*8.5)
30028          ENDIF
30029        ELSE
30030          IF(IDMODE(I).EQ.'WINT'.OR.IDMODE(I).EQ.'INTE')THEN
30031            IDNHPP(I)=600
30032            IDNVPP(I)=450
30033          ELSE
30034            IDNHPP(I)=INT(1000.*11.)
30035            IDNVPP(I)=INT(1000.*8.5)
30036          ENDIF
30037        ENDIF
30038C
30039        IDNVOF(I)=0
30040        IDNHOF(I)=0
30041        GOTO8900
30042      ELSEIF(IDMANU(I).EQ.'QWIN')THEN
30043        IDCONT(I)='ON'
30044        IDCOLO(I)='ON'
30045        IDNHPP(I)=-1
30046        IDNVPP(I)=-1
30047        IDNVOF(I)=0
30048        IDNHOF(I)=0
30049        IF(IFEEDB.EQ.'ON')THEN
30050          WRITE(ICOUT,999)
30051          CALL DPWRST('XXX','BUG ')
30052          WRITE(ICOUT,7902)
30053 7902     FORMAT('MICROSOFT QUICK-WIN DRIVER')
30054          CALL DPWRST('XXX','BUG ')
30055         ENDIF
30056        GOTO8900
30057      ELSEIF(IDMANU(I).EQ.'GKS ')THEN
30058        IDCONT(I)='ON'
30059        IDCOLO(I)='ON'
30060        IDNHPP(I)=1000
30061        IDNVPP(I)=1000
30062        IDNVOF(I)=0
30063        IDNHOF(I)=0
30064        IF(IFEEDB.EQ.'ON')THEN
30065          WRITE(ICOUT,999)
30066          CALL DPWRST('XXX','BUG ')
30067          WRITE(ICOUT,8002)
30068 8002     FORMAT('GKS LIBRARY')
30069          CALL DPWRST('XXX','BUG ')
30070        ENDIF
30071        GOTO8900
30072      ELSEIF(IDMANU(I).EQ.'GD  ')THEN
30073        IDCONT(I)='ON'
30074        IDCOLO(I)='ON'
30075        IDNHPP(I)=600
30076        IDNVPP(I)=465
30077        IDNVOF(I)=0
30078        IDNHOF(I)=0
30079        IF(IORNSW.EQ.'PORT')THEN
30080          IDNHPP(I)=465
30081          IDNVPP(I)=600
30082        ELSEIF(IORNSW.EQ.'LAN2')THEN
30083          IDNHPP(I)=465
30084          IDNVPP(I)=360
30085          IDNVOF(I)=220
30086          IDNHOF(I)=0
30087        ELSEIF(IORNSW.EQ.'SQUA')THEN
30088          IDNHPP(I)=465
30089          IDNVPP(I)=465
30090          IDNVOF(I)=0
30091          IDNHOF(I)=0
30092        ENDIF
30093        IDFONT(I)='SIMP'
30094        IF(IFEEDB.EQ.'ON')THEN
30095          WRITE(ICOUT,999)
30096          CALL DPWRST('XXX','BUG ')
30097          WRITE(ICOUT,8202)IDMODE(I)
30098 8202     FORMAT('GD LIBRARY--',A4)
30099          CALL DPWRST('XXX','BUG ')
30100        ENDIF
30101        GOTO8900
30102      ELSEIF(IDMANU(I).EQ.'OPGL')THEN
30103        IDCONT(I)='ON'
30104        IDCOLO(I)='ON'
30105        IDNHPP(I)=600
30106        IDNVPP(I)=450
30107        IDNVOF(I)=0
30108        IDNHOF(I)=0
30109        IF(IORNSW.EQ.'PORT')THEN
30110          IDNHPP(I)=450
30111          IDNVPP(I)=600
30112        ELSEIF(IORNSW.EQ.'LAN2')THEN
30113          IDNHPP(I)=450
30114          IDNVPP(I)=350
30115          IDNVOF(I)=125
30116          IDNHOF(I)=0
30117        ENDIF
30118        IF(IFEEDB.EQ.'ON')THEN
30119          WRITE(ICOUT,999)
30120          CALL DPWRST('XXX','BUG ')
30121          WRITE(ICOUT,8302)
30122 8302     FORMAT('OPEN-GL (BASED ON f90gl)')
30123          CALL DPWRST('XXX','BUG ')
30124        ENDIF
30125        GOTO8900
30126      ELSEIF(IDMANU(I).EQ.'ABSO')THEN
30127        IDCONT(I)='ON'
30128        IDCOLO(I)='ON'
30129        IDNHPP(I)=600
30130        IDNVPP(I)=450
30131        IDNVOF(I)=0
30132        IDNHOF(I)=0
30133        IF(IORNSW.EQ.'PORT')THEN
30134          IDNHPP(I)=450
30135          IDNVPP(I)=600
30136        ELSEIF(IORNSW.EQ.'LAN2')THEN
30137          IDNHPP(I)=450
30138          IDNVPP(I)=350
30139          IDNVOF(I)=125
30140          IDNHOF(I)=0
30141        ELSEIF(IORNSW.EQ.'SQUA')THEN
30142          IDNHPP(I)=450
30143          IDNVPP(I)=450
30144          IDNVOF(I)=0
30145          IDNHOF(I)=0
30146        ENDIF
30147        IF(IFEEDB.EQ.'ON')THEN
30148          WRITE(ICOUT,999)
30149          CALL DPWRST('XXX','BUG ')
30150          WRITE(ICOUT,5102)
30151 5102     FORMAT('ABSOFT (=PLPLOT) LIBRARY)')
30152          CALL DPWRST('XXX','BUG ')
30153        ENDIF
30154        GOTO8900
30155      ELSEIF(IDMANU(I).EQ.'LATE' .OR. IDMANU(I).EQ.'EEPI')THEN
30156C
30157C       TREAT THE LATEX CASE--
30158C       USE 72 DPI COORDINATE SCALE STARTING FROM
30159C       LOWER LEFT CORNER.  SUPPORT PORTRAIT AND
30160C       LANDSCAPE WORDPERFECT OPTIONS.  REGULAR
30161C       LANDSCAPE MODE WILL BE TREATED SAME AS
30162C       LANDSCAPE WORDPERFECT (I.E., LANDSCAPE
30163C       MODE IN A PORTRAIT PAGE).
30164C
30165C       NOTE: IF CAPTURE SWITCH IS ON AND THIS IS DEVICE 1, THEN
30166C             SET IGUNIT EQUAL TO CAPTURE FILE.
30167C
30168        IFLAG9=0
30169        IF(I.EQ.1 .AND. IPR.EQ.ICAPNU)THEN
30170          IGUNIT=ICAPNU
30171          IFLAG9=1
30172        ENDIF
30173        IDNVOF(I)=0
30174        IDNHOF(I)=0
30175        ADOTPI=300.0
30176        IF(IORNSW.EQ.'PORT')THEN
30177          IDNHPP(I)=INT(6.25*ADOTPI)
30178          IDNVPP(I)=INT(9.0*ADOTPI)
30179        ELSEIF(IORNSW.EQ.'LAND')THEN
30180          IDNHPP(I)=INT(6.25*ADOTPI)
30181          IDNVPP(I)=INT((6.25*ADOTPI)*(8.5/11.0))
30182        ELSEIF(IORNSW.EQ.'LAN2')THEN
30183          IDNHPP(I)=INT(6.25*ADOTPI)
30184          IDNVPP(I)=INT((6.25*ADOTPI)*(8.5/11.0))
30185        ELSEIF(IORNSW.EQ.'SQUA')THEN
30186          IDNHPP(I)=INT(6.0*ADOTPI)
30187          IDNVPP(I)=INT(6.0*ADOTPI)
30188        ELSE
30189          IDNHPP(I)=INT(6.25*ADOTPI)
30190          IDNVPP(I)=INT((6.25*ADOTPI)*(8.5/11.0))
30191        ENDIF
30192        IF(IFLAG9.EQ.0 .AND. IFEEDB.EQ.'ON')THEN
30193          WRITE(ICOUT,999)
30194          CALL DPWRST('XXX','BUG ')
30195          WRITE(ICOUT,8402)IDMODE(I)
30196 8402     FORMAT('LATEX (USING EPIC/EEPIC/GRAPHICS)--',A4)
30197          CALL DPWRST('XXX','BUG ')
30198          GOTO8900
30199        ELSE
30200          GOTO8919
30201        ENDIF
30202      ELSEIF(IDMANU(I).EQ.'SVG ')THEN
30203C
30204C       NOTE 09/2010: ALLOW USER TO SPECIFY DESIRED HORIZONTAL/VERTICAL
30205C                     SIZE IN THE SVG COMMAND, E.G.:
30206C                     DEVICE 1 SVG 800 500
30207        IXDEFA=600
30208        IYDEFA=450
30209C
30210        IF(IDMODE(I).NE.'    ')THEN
30211          READ(IDMODE(I)(1:4),'(I4)',ERR=8610)IXDEFA
30212          IF(IXDEFA.LT.200)IXDEFA=200
30213          IF(IXDEFA.GT.1200)IXDEFA=1200
30214        ENDIF
30215        IF(IDMOD2(I).NE.'    ')THEN
30216          READ(IDMOD2(I)(1:4),'(I4)',ERR=8610)IYDEFA
30217          IF(IYDEFA.LT.200)IYDEFA=200
30218          IF(IYDEFA.GT.1200)IYDEFA=1200
30219        ENDIF
30220        GOTO8610
30221      ELSEIF(IDMANU(I).EQ.'AQUA')THEN
30222C
30223C       NOTE: ALLOW USER TO SPECIFY DESIRED HORIZONTAL/VERTICAL SIZE
30224C             IN THE AQUA COMMAND, E.G.:  DEVICE 1 AQUA 600 400
30225        IXDEFA=600
30226        IYDEFA=450
30227C
30228        IF(IDMODE(I).NE.'    ')THEN
30229          READ(IDMODE(I)(1:4),'(I4)',ERR=8610)IXDEFA
30230          IF(IXDEFA.LT.200)IXDEFA=200
30231          IF(IXDEFA.GT.1200)IXDEFA=1200
30232        ENDIF
30233        IF(IDMOD2(I).NE.'    ')THEN
30234          READ(IDMOD2(I)(1:4),'(I4)',ERR=8610)IYDEFA
30235          IF(IYDEFA.LT.200)IYDEFA=200
30236          IF(IYDEFA.GT.1200)IYDEFA=1200
30237        ENDIF
30238        GOTO8610
30239      ELSEIF(IDMANU(I).EQ.'CAIR')THEN
30240C
30241C       DEFAULT PICTURE POINTS (BASED ON 72 DPI) FOR VARIOUS SETTINGS
30242C       FOR ORIENTATION.  THESE ARE BASED ON POSTSCRIPT DIMENSIONS, BUT
30243C       USE FOR OTHER DEVICES AS WELL.  USER CAN SPECIFY EXPLICIT
30244C       SETTINGS IF DESIRED.
30245C
30246        IF(IORNSW.EQ.'LAND')THEN
30247          IXDEFA=792
30248          IYDEFA=612
30249        ELSEIF(IORNSW.EQ.'PORT')THEN
30250          IXDEFA=612
30251          IYDEFA=792
30252        ELSEIF(IORNSW.EQ.'SQUA')THEN
30253          IXDEFA=612
30254          IYDEFA=612
30255        ELSEIF(IORNSW.EQ.'LAN2')THEN
30256          IXDEFA=612
30257          IYDEFA=468
30258        ELSE
30259          IXDEFA=792
30260          IYDEFA=612
30261        ENDIF
30262C
30263        IF(IDMOD2(I).NE.'    ')THEN
30264          READ(IDMOD2(I)(1:4),'(I4)',ERR=8610)IXDEFA
30265          IF(IXDEFA.LT.100)IXDEFA=100
30266          IF(IXDEFA.GT.10000)IXDEFA=10000
30267        ENDIF
30268        IF(IDMOD3(I).NE.'    ')THEN
30269          READ(IDMOD3(I)(1:4),'(I4)',ERR=8610)IYDEFA
30270          IF(IYDEFA.LT.100)IYDEFA=100
30271          IF(IYDEFA.GT.10000)IYDEFA=10000
30272        ENDIF
30273        IDCONT(I)='ON'
30274        IDCOLO(I)='ON'
30275        IDNHPP(I)=IXDEFA
30276        IDNVPP(I)=IYDEFA
30277        IDNHOF(I)=0
30278        IDNVOF(I)=0
30279        GOTO8900
30280C
30281      ELSEIF(IDMANU(I).EQ.'WMF ')THEN
30282        GOTO8610
30283      ELSEIF(IDMANU(I).EQ.'D3  ')THEN
30284        GOTO8610
30285      ENDIF
30286C
30287 8610 CONTINUE
30288C
30289      IDCONT(I)='ON'
30290      IDCOLO(I)='ON'
30291      IDNHPP(I)=IXDEFA
30292      IDNVPP(I)=IYDEFA
30293      IDNVOF(I)=0
30294      IDNHOF(I)=0
30295      IF(IORNSW.EQ.'PORT')THEN
30296        IDNHPP(I)=450
30297        IDNVPP(I)=600
30298      ELSEIF(IORNSW.EQ.'LAN2')THEN
30299        IDNHPP(I)=450
30300        IDNVPP(I)=350
30301        IDNVOF(I)=125
30302        IDNHOF(I)=0
30303      ELSEIF(IORNSW.EQ.'SQUA')THEN
30304        IDNHPP(I)=450
30305        IDNVPP(I)=450
30306        IDNVOF(I)=0
30307        IDNHOF(I)=0
30308      ENDIF
30309      IF(IFEEDB.EQ.'ON')THEN
30310        WRITE(ICOUT,999)
30311        CALL DPWRST('XXX','BUG ')
30312        IF(IDMANU(I).EQ.'AQUA')THEN
30313          WRITE(ICOUT,8612)
30314 8612     FORMAT('AQUATERM (FOR MAC OSX)')
30315          CALL DPWRST('XXX','BUG ')
30316        ELSEIF(IDMANU(I).EQ.'SVG')THEN
30317          WRITE(ICOUT,8613)
30318 8613     FORMAT('SCALABLE VECTOR GRAPHICS (SVG)')
30319          CALL DPWRST('XXX','BUG ')
30320        ELSEIF(IDMANU(I).EQ.'CAIR')THEN
30321          WRITE(ICOUT,8615)IDMODE(I)
30322 8615     FORMAT('CAIRO (',A4,')')
30323          CALL DPWRST('XXX','BUG ')
30324        ENDIF
30325      ENDIF
30326      GOTO8900
30327C
30328 8900 CONTINUE
30329      IF(IFEEDB.EQ.'ON')THEN
30330        WRITE(ICOUT,8910)
30331 8910   FORMAT('PICTURE POINTS--')
30332        CALL DPWRST('XXX','BUG ')
30333        WRITE(ICOUT,8911)IDNHPP(I)
30334 8911   FORMAT(12X,'HORIZONTAL = ',I8)
30335        CALL DPWRST('XXX','BUG ')
30336        WRITE(ICOUT,8912)IDNVPP(I)
30337 8912   FORMAT(12X,'VERTICAL   = ',I8)
30338        CALL DPWRST('XXX','BUG ')
30339      ENDIF
30340C
30341 8919 CONTINUE
30342      IFOUN2='YES'
30343      GOTO9000
30344C
30345C               *****************
30346C               **  STEP 90--  **
30347C               **  EXIT       **
30348C               *****************
30349C
30350 9000 CONTINUE
30351C
30352      IF(IBUGO2.EQ.'ON')THEN
30353        WRITE(ICOUT,51)
30354   51   FORMAT('AT THE BEGINNING OF GRSEPP')
30355        CALL DPWRST('XXX','BUG ')
30356      ENDIF
30357C
30358      RETURN
30359      END
30360      SUBROUTINE GRSESI(ICASE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP,
30361     1                  JSIZE,JHEIG2,JWIDT2,JVEGA2,JHOGA2,
30362     1                  PHEIG2,PWIDT2,PVEGA2,PHOGA2)
30363C
30364C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, SET A SIZE (E.G., A
30365C              CHARACTER SIZE) (HEIGHT, WIDTH, VERTICAL GAP, HORIZONTAL
30366C              GAP9 GIVEN IN (0.0 TO 100.0) REPRESENTATION INTO AN
30367C              INTEGER NUMERIC REPRESENTATION (IN JSIZE) THAT WILL BE
30368C              UNDERSTOOD BY THE TEKTRONIX GRAPHICS DEVICE BEING USED.
30369C              ALSO, CREATE OTHER VARIABLES WHICH CONTAIN THE CLOSEST
30370C              ALLOWABLE SIZES (IN 0.0 TO 100.0 UNITS) THAT IS PERMITTED
30371C              ON THE TEKTRONIX GRAPHICS DEVICE BEING USED.
30372C
30373C     WRITTEN BY--JAMES J. FILLIBEN
30374C                 STATISTICAL ENGINEERING DIVISION
30375C                 INFORMATION TECHNOLOGY LABORATORY
30376C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
30377C                 GAITHERSBURG, MD 20899-8980
30378C                 PVONE--301-975-2855
30379C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
30380C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
30381C     LANGUAGE--ANSI FORTRAN (1977)
30382C     VERSION NUMBER--83.6
30383C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
30384C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
30385C                                      DRIVER OBSOLETE
30386C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
30387C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
30388C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
30389C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
30390C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
30391C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
30392C     UPDATED         --MARCH    1991. REGIS FIX (BY ALAN HECKERT)
30393C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
30394C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
30395C                                      DRIVER OBSOLETE
30396C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
30397C                                      OLD STYLE CALCOMP
30398C                                      DRIVER OBSOLETE
30399C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
30400C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
30401C                                      USE BILL MITCHELLS OPENGL
30402C                                      BINDING FOR FORTRAN
30403C     UPDATED         --OCTOBER  1996. GKS (ALAN)
30404C                                      CODED, NOT TESTED
30405C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
30406C                                      PLACEHOLDER FOR NOW
30407C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
30408C                                      PLACEHOLDER FOR NOW
30409C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
30410C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
30411C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
30412C     UPDATED         --JUNE     2000. MACINTOSH
30413C                                      PLACEHOLDER FOR NOW
30414C     UPDATED         --JUNE     2000. PC PRINTER
30415C                                      PLACEHOLDER FOR NOW
30416C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
30417C     UPDATED         --FEBRUARY 2006. SUPPORT FOR LATEX
30418C     UPDATED         --APRIL    2009. IMPLEMENT LIBPLOT DRIVER
30419C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
30420C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
30421C     UPDATED         --APRIL    2016. MODIFICATIONS TO QWIN DRIVER
30422C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
30423C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
30424C                                      GRAPHICS DEVICES
30425C
30426C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
30427C
30428#ifdef HAVE_WININTERACTER
30429      USE WINTERACTER
30430#endif
30431#ifdef HAVE_INTERACTER
30432      USE INTERACTER
30433#endif
30434#ifdef HAVE_QWIN
30435CQWIN USE DFLIB
30436      USE IFQWIN
30437      TYPE(FONTINFO) MSFONT
30438      TYPE (WINDOWCONFIG)   DPSCREEN
30439      CHARACTER*4 QWSCRN
30440      COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
30441#endif
30442      CHARACTER*1 IQUOTE
30443      CHARACTER*4 ICASE
30444      CHARACTER*4 IFONT
30445      CHARACTER*130 ICSTR
30446      CHARACTER*4 ISUBN0
30447C
30448C-----COMMON----------------------------------------------------------
30449C
30450      INCLUDE 'DPCOPA.INC'
30451      INCLUDE 'DPCOGR.INC'
30452      INCLUDE 'DPCONP.INC'
30453      INCLUDE 'DPCOBE.INC'
30454      INCLUDE 'DPCODV.INC'
30455      INCLUDE 'DPCOF2.INC'
30456      INCLUDE 'DPCOP2.INC'
30457C
30458C-----START POINT-----------------------------------------------------
30459C
30460      CALL DPCONA(39,IQUOTE)
30461      ISUBN0='SESI'
30462      IERRG4='NO'
30463C
30464      NCSTR=(-999)
30465      PVETO2=(-999.0)
30466      PHOTO2=(-999.0)
30467C
30468      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SESI')THEN
30469        WRITE(ICOUT,999)
30470  999   FORMAT(1X)
30471        CALL DPWRST('XXX','BUG ')
30472        WRITE(ICOUT,51)
30473   51   FORMAT('***** AT THE BEGINNING OF GRSESI--')
30474        CALL DPWRST('XXX','BUG ')
30475        WRITE(ICOUT,52)ICASE,IFONT,JSIZE
30476   52   FORMAT('ICASE,IFONT,JSIZE = ',2(A4,2X),I8)
30477        CALL DPWRST('XXX','BUG ')
30478        WRITE(ICOUT,53)PHEIGH,PWIDTH,PVEGAP,PHOGAP
30479   53   FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4G15.7)
30480        CALL DPWRST('XXX','BUG ')
30481        WRITE(ICOUT,55)JHEIG2,JWIDT2,JVEGA2,JHOGA2
30482   55   FORMAT('JHEIG2,JWIDT2,JVEGA2,JHOGA2 = ',4I8)
30483        CALL DPWRST('XXX','BUG ')
30484        WRITE(ICOUT,56)PHEIG2,PWIDT2,PVEGA2,PHOGA2
30485   56   FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4G15.7)
30486        CALL DPWRST('XXX','BUG ')
30487        WRITE(ICOUT,57)IMANUF,IMODEL,IBUGG4
30488   57   FORMAT('IMANUF,IMODEL,IBUGG4 = ',2(A4,2X),A4)
30489        CALL DPWRST('XXX','BUG ')
30490      ENDIF
30491C
30492C               ********************************************
30493C               **  STEP 1--                              **
30494C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
30495C               **  AND THE MODEL                         **
30496C               ********************************************
30497C
30498      IF(IMANUF.EQ.'QWIN')THEN
30499        GOTO4700
30500      ELSEIF(IMANUF.EQ.'POST')THEN
30501        GOTO8600
30502      ELSEIF(IMANUF.EQ.'X11 ')THEN
30503        GOTO9600
30504      ELSEIF(IMANUF.EQ.'AQUA')THEN
30505        GOTO13500
30506      ELSEIF(IMANUF.EQ.'GENE')THEN
30507        IF(IMODEL.EQ.'CODE')GOTO3200
30508        IF(IMODEL.EQ.'CGM')GOTO3300
30509        IF(IMODEL.EQ.'CGMB')GOTO3400
30510        GOTO3100
30511      ELSEIF(IMANUF.EQ.'SVG ')THEN
30512        GOTO16000
30513      ELSEIF(IMANUF.EQ.'GD  ')THEN
30514        GOTO12000
30515      ELSEIF(IMANUF.EQ.'LATE')THEN
30516        GOTO15000
30517      ELSEIF(IMANUF.EQ.'CAIR')THEN
30518        GOTO17000
30519      ELSEIF(IMANUF.EQ.'D3  ')THEN
30520        GOTO19000
30521      ELSEIF(IMANUF.EQ.'WMF ')THEN
30522        GOTO18000
30523      ELSEIF(IMANUF.EQ.'OPGL')THEN
30524        GOTO4800
30525      ELSEIF(IMANUF.EQ.'TEKT')THEN
30526        IF(IMODEL.EQ.'4012')GOTO1100
30527        IF(IMODEL.EQ.'4013')GOTO1100
30528        IF(IMODEL.EQ.'4014')GOTO1100
30529        IF(IMODEL.EQ.'4015')GOTO1100
30530        IF(IMODEL.EQ.'4016')GOTO1100
30531C
30532        IF(IMODEL.EQ.'4054')GOTO1100
30533C
30534        IF(IMODEL.EQ.'4113')GOTO1100
30535        IF(IMODEL.EQ.'4114')GOTO1100
30536C
30537        IF(IMODEL.EQ.'4662')GOTO1200
30538C
30539        GOTO9000
30540      ELSEIF(IMANUF.EQ.'HP')THEN
30541        IF(IMODEL.EQ.'7221')GOTO2100
30542        IF(IMODEL.EQ.'2622')GOTO2300
30543        IF(IMODEL.EQ.'2623')GOTO2300
30544        IF(IMODEL.EQ.'2627')GOTO2300
30545        IF(IMODEL.EQ.'2647')GOTO2300
30546        GOTO2200
30547      ELSEIF(IMANUF.EQ.'LIBP')THEN
30548        GOTO2600
30549      ELSEIF(IMANUF.EQ.'REGI')THEN
30550        GOTO8100
30551      ELSEIF(IMANUF.EQ.'GKS ')THEN
30552        GOTO11000
30553      ELSEIF(IMANUF.EQ.'LAHE')THEN
30554        IF(IMODEL.EQ.'INTE')GOTO4900
30555        IF(IMODEL.EQ.'WINT')GOTO4950
30556        GOTO4600
30557      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
30558        GOTO13000
30559      ELSEIF(IMANUF.EQ.'QUIC')THEN
30560        GOTO9100
30561      ELSEIF(IMANUF.EQ.'CALC')THEN
30562        GOTO4100
30563      ELSEIF(IMANUF.EQ.'ZETA')THEN
30564        GOTO5100
30565      ELSEIF(IMANUF.EQ.'TURB')THEN
30566        GOTO10000
30567      ELSEIF(IMANUF.EQ.'SUN ')THEN
30568        GOTO6600
30569      ENDIF
30570      GOTO9000
30571C
30572C               ********************************************************
30573C               **  STEP 11--                                         **
30574C               **  TREAT THE TEKTRONIX 4012, 4013, 4014, 4016, 4054, **
30575C               **  AND 4114 (THESE ARE ALL NON-COLOR (= MONOCHROME)  **
30576C               **  DEVICES WHICH ARE LARGE SCREEN AND SO HAVE 4      **
30577C               **  CHARCTER SIZES.) REFERENCE--XXX                   **
30578C               ********************************************************
30579C
30580 1100 CONTINUE
30581      ICSTR(1:1)=IESCC
30582      ICSTR(2:2)=';'
30583      IF(JSIZE.EQ.2)ICSTR(2:2)=':'
30584      IF(JSIZE.EQ.3)ICSTR(2:2)='9'
30585      IF(JSIZE.EQ.4)ICSTR(2:2)='8'
30586      NCSTR=2
30587      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
30588      GOTO9000
30589C
30590C               ****************************************************
30591C               **  STEP 12--                                     **
30592C               **  TREAT THE TEKTRONIX 4662 PENPLOTTER CASE      **
30593C               **  REFERENCE--XXX                                **
30594C               ****************************************************
30595C
30596 1200 CONTINUE
30597      ICSTR(1:1)=IESCC
30598      ICSTR(2:8)='AI31,48'
30599      IF(JSIZE.EQ.2)ICSTR(2:8)='AI34,53'
30600      IF(JSIZE.EQ.3)ICSTR(2:8)='AI51,82'
30601      IF(JSIZE.EQ.4)ICSTR(2:8)='AI56,88'
30602      NCSTR=8
30603      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
30604      GOTO9000
30605C
30606C               ******************************************************
30607C               **  STEP 21--                                       **
30608C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
30609C               **  (MULTI-COLOR PENPLOTTER)                        **
30610C               **  TO SET SIZE--                                   **
30611C               **  USE THE TILDA PERCENT (= LABEL SIZE) INSTRUCTION*
30612C               **  AND PACKED BINARY COORDINATES,                  **
30613C               **  (WITH TRAILING RIGHT CURLY BRACKET WHICH ARE THE**
30614C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
30615C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
30616C               **             OPERATING AND PROGRAMMING MANUAL,    **
30617C               **             PAGE 119-121.                        **
30618C               ******************************************************
30619C
30620 2100 CONTINUE
30621      ICSTR(1:2)='~%'
30622      NCSTR=2
30623      PVETO2=PHEIG2+PVEGA2
30624      PHOTO2=PWIDT2+PHOGA2
30625      CALL GRTRSD(PHOTO2,PVETO2,IX,IY,ISUBN0)
30626      CALL HPTRPT(IX,IY,ICSTR,NCSTR,ISUBN0)
30627      NCSTR=NCSTR+1
30628      ICSTR(NCSTR:NCSTR)='}'
30629      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
30630      GOTO9000
30631C
30632C               ******************************************************
30633C               **  STEP 22--                                       **
30634C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
30635C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
30636C               **  (MULTI-COLOR PENPLOTTERS)                       **
30637C               **  TO SET SIZE--                                   **
30638C               **  USE THE SR (= REL CHAR SIZE) INSTRUCTION        **
30639C               **  ALONG WITH FLOATING POINT COORDINATES,          **
30640C               **  (WITH   TRAILING SEMI-COLONS WHICH ARE THE      **
30641C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
30642C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
30643C               **             OPERATING AND PROGRAMMING MANUAL,    **
30644C               **             PAGE 84-85, 144.                     **
30645C               ******************************************************
30646C
30647 2200 CONTINUE
30648      ICSTR(1:2)='SR'
30649      NCSTR=2
30650      NCHTOT=10
30651      NCHDEC=1
30652      CALL GRTRRE(PWIDT2,NCHTOT,NCHDEC,ICSTR,NCSTR)
30653      ICSTR(13:13)=','
30654      NCSTR=13
30655      CALL GRTRRE(PHEIG2,NCHTOT,NCHDEC,ICSTR,NCSTR)
30656      ICSTR(24:24)=';'
30657      NCSTR=24
30658      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
30659      GOTO9000
30660C
30661C               **********************************************************
30662C               **  STEP 23--                                           **
30663C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
30664C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
30665C               **  (MONOCHROME DISPLAY TERMINALS)                      **
30666C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
30667C               **             REFERENCE MANUAL,                        **
30668C               **             PAGE 10-19, XXX.                         **
30669C               **********************************************************
30670C
30671 2300 CONTINUE
30672C     NEEDS MORE WORK FOR FULL 8 SIZES
30673      ICSTR(1:1)=IESCC
30674      ICSTR(2:6)='*m1mZ'
30675      IF(PHEIG2.GT.3.0)ICSTR(2:6)='*m2mZ'
30676      IF(PHEIG2.GT.6.0)ICSTR(2:6)='*m3mZ'
30677      IF(PHEIG2.GT.9.0)ICSTR(2:6)='*m4mZ'
30678      IF(PHEIG2.GT.11.0)ICSTR(2:6)='*m5mZ'
30679      IF(PHEIG2.GT.14.0)ICSTR(2:6)='*m6mZ'
30680      IF(PHEIG2.GT.17.0)ICSTR(2:6)='*m8mZ'
30681      NCSTR=6
30682      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
30683      GOTO9000
30684C
30685C               **********************************************************
30686C               **  STEP 26--                                           **
30687C               **  TREAT THE UNIX LIBPLOT            CASE              **
30688C               **  SIZE WILL BE SET IN GRWRTH AND GRWRTV               **
30689C               **********************************************************
30690C
30691 2600 CONTINUE
30692      GOTO9000
30693C
30694C               ******************************************************
30695C               **  STEP 31--                                       **
30696C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
30697C               ******************************************************
30698C
30699 3100 CONTINUE
30700      ICSTR(1:20)='SET SIZE CHARACTERS '
30701      NCSTR=20
30702      NCHTOT=10
30703      NCHDEC=5
30704      CALL GRTRRE(PHEIGH,NCHTOT,NCHDEC,ICSTR,NCSTR)
30705      ICSTR(31:32)='  '
30706      NCSTR=32
30707      CALL GRTRRE(PWIDTH,NCHTOT,NCHDEC,ICSTR,NCSTR)
30708      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
30709      GOTO9000
30710C
30711C               ***************************************************************
30712C               **  STEP 32--                                                **
30713C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
30714C               ***************************************************************
30715C
30716 3200 CONTINUE
30717      ICSTR(1:5)='SESI '
30718      NCSTR=5
30719      NCHTOT=10
30720      NCHDEC=5
30721      CALL GRTRRE(PHEIGH,NCHTOT,NCHDEC,ICSTR,NCSTR)
30722      ICSTR(16:17)='  '
30723      NCSTR=17
30724      CALL GRTRRE(PWIDTH,NCHTOT,NCHDEC,ICSTR,NCSTR)
30725      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
30726      GOTO9000
30727C
30728C               ***************************************************************
30729C               **  STEP 33--                                                **
30730C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
30731C               ***************************************************************
30732C
30733 3300 CONTINUE
30734      ICSTR(1:11)='CHARHEIGHT '
30735      NCSTR=10
30736      NCHTOT=10
30737      NCHDEC=5
30738      CALL GRTRRE(PHEIGH,NCHTOT,NCHDEC,ICSTR,NCSTR)
30739      ICSTR(22:22)=';'
30740      NCSTR=22
30741      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
30742      GOTO9000
30743C
30744C               ***************************************************
30745C               **  STEP 34--                                    **
30746C               **  TREAT THE CGM (BINARY)                 CASE  **
30747C               ***************************************************
30748C
30749 3400 CONTINUE
30750      GOTO9000
30751C
30752C               ******************************************************
30753C               **  STEP 41--                                       **
30754C               **  TREAT THE CALCOMP XXXXXX CASE                   **
30755C               **  TO SET SIZE--                                   **
30756C               **  WRITE OUT AN XXXXXXXXXX                         **
30757C               **  (NOT DONE)                                      **
30758C               **  REFERENCE--XX                                   **
30759C               **             XX                                   **
30760C               **             PAGES XX AND XX                      **
30761C               **  USE CALCOMP LIBRARY.  SIZE SENT TO "SYMBOL"     **
30762C               **  SUBROUTINE IN "GRWRTH" AND "GRWRTV".            **
30763C               ******************************************************
30764C
30765 4100 CONTINUE
30766      GOTO9000
30767C
30768C               ******************************************************
30769C               **  STEP 46--                                       **
30770C               **  TREAT THE LAHEY   XXXXXX CASE                   **
30771C               **  REFERENCE--Programmer's Reference, Revision C   **
30772C               **             Lahey Computer Systems, January, 1992**
30773C               **             PAGES 51 THRU 65                     **
30774C               ******************************************************
30775C
30776 4600 CONTINUE
30777      GOTO9000
30778C
30779C               ******************************************************
30780C               **  STEP 47--                                       **
30781C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
30782C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
30783C               ******************************************************
30784C
30785C     2016/04: REWRITE THIS SECTION.  WANT ARGUMENT TO SETFONT TO
30786C              LOOK SOMETHING LIKE
30787C
30788C                  t'Arial''h17w10eb'
30789C
30790 4700 CONTINUE
30791#ifdef HAVE_QWIN
30792      IF(IQWNFT.LT.1)GOTO9000
30793      ICSTR=' '
30794      ICSTR(1:1)='t'
30795      ICSTR(2:2)=IQUOTE
30796      NCH=0
30797      DO4710I=32,1,-1
30798        IF(IQWNFZ(I:I).NE.' ')THEN
30799          NCH=I
30800          GOTO4719
30801        ENDIF
30802 4710 CONTINUE
30803 4719 CONTINUE
30804      IF(NCH.EQ.0)THEN
30805        ICSTR(3:7)='Arial'
30806        ICSTR(8:8)=IQUOTE
30807        NCSTR=8
30808      ELSE
30809        NCSTR=3+NCH-1
30810        ICSTR(3:NCSTR)=IQWNFZ(1:NCH)
30811        NCSTR=NCSTR+1
30812        ICSTR(NCSTR:NCSTR)=IQUOTE
30813      ENDIF
30814      NCSTR=NCSTR+1
30815      ICSTR(NCSTR:NCSTR)=IQUOTE
30816      NCSTR=NCSTR+1
30817      ICSTR(NCSTR:NCSTR)='h'
30818      NCSTR=NCSTR+1
30819      IF(JHEIG2.LE.5)JHEIG2=5
30820      IF(JHEIG2.GE.30)JHEIG2=30
30821      WRITE(ICSTR(NCSTR:NCSTR+1),'(I2.2)')JHEIG2
30822      NCSTR=NCSTR+2
30823      ICSTR(NCSTR:NCSTR)='w'
30824      NCSTR=NCSTR+1
30825      IF(JWIDT2.LE.5)JWIDT2=5
30826      IF(JWIDT2.GE.30)JWIDT2=30
30827      WRITE(ICSTR(NCSTR:NCSTR+1),'(I2.2)')JWIDT2
30828      NCSTR=NCSTR+1
30829      IF(IQWNST.EQ.'ITAL')THEN
30830        NCSTR=NCSTR+1
30831        ICSTR(NCSTR:NCSTR)='i'
30832      ENDIF
30833      IF(IQWNFW.EQ.'BOLD')THEN
30834        NCSTR=NCSTR+1
30835        ICSTR(NCSTR:NCSTR)='e'
30836      ENDIF
30837      NCSTR=NCSTR+1
30838      ICSTR(NCSTR:NCSTR)='b'
30839      NCSTR=NCSTR+1
30840      ICSTR(NCSTR:NCSTR)=IQUOTE
30841      IRESLT=SETFONT(ICSTR(1:NCSTR))
30842      IRESLT=GETFONTINFO(MSFONT)
30843      JHEIG2=MSFONT.PIXHEIGHT
30844      JWIDT2=MSFONT.PIXWIDTH
30845      IF(JHEIG2.EQ.0)JHEIG2=16
30846      IF(JWIDT2.EQ.0)JWDT2=8
30847#endif
30848      GOTO9000
30849C
30850C               ******************************************************
30851C               **  STEP 48--                                       **
30852C               **  TREAT THE OPEN-GL DRIVER                        **
30853C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
30854C               ******************************************************
30855C
30856 4800 CONTINUE
30857      GOTO9000
30858C
30859C               ******************************************************
30860C               **  STEP 49--                                       **
30861C               **  TREAT THE LAHEY INTERACTOR CASE                 **
30862C               ******************************************************
30863C
30864 4900 CONTINUE
30865#ifdef HAVE_INTERACTER
30866      CALL IGrCharSize(PHEIG2,PWIDT2)
30867#endif
30868      GOTO9000
30869C
30870C               ******************************************************
30871C               **  STEP 49B-                                       **
30872C               **  TREAT THE LAHEY WINTERACTOR CASE                **
30873C               ******************************************************
30874C
30875 4950 CONTINUE
30876      ATEMP=1.5
30877      AHEIG=PHEIG2/(100.0*(1.0/25.0))
30878      AWIDTH=PWIDT2/(ATEMP*100.0*(1.0/75.0))
30879#ifdef HAVE_WININTERACTER
30880      CALL IGrCharSize(AHEIG,AWIDTH)
30881#endif
30882      GOTO9000
30883C
30884C
30885C               ******************************************************
30886C               **  STEP 51--                                       **
30887C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
30888C               **  TO SET SIZE--                                   **
30889C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
30890C               **             MODELS 3600SX AND 3653SX             **
30891C               **             PAGES B-0 AND B-1                    **
30892C               **  USE ZETA VERSION OF CALCOMP LIBRARY.  SIZE      **
30893C               **  SENT TO "SYMBOL" ROUTINE IN "GRWRTH" AND "GRWRTV"**
30894C               **  HOWEVER, SET THE CHARACTER ASPECT RATIO IN GRTRSI*
30895C               ******************************************************
30896C
30897 5100 CONTINUE
30898      GOTO9000
30899C
30900C
30901C               ******************************************************
30902C               **  STEP 66--                                       **
30903C               **  TREAT THE SUN CASE - WRITTEN BY BILL ANDERSON   **
30904C               ******************************************************
30905C
30906 6600 CONTINUE
30907      IDUMMY  = INT(PHEIG2*100)
30908#ifdef HAVE_SUN
30909      CALL cfcharheight(IDUMMY)
30910#endif
30911      GOTO 9000
30912C
30913C               ******************************************************
30914C               **  STEP 81--                                       **
30915C               **  TREAT THE DEC  REGIS CASE                       **
30916C               **  TO SET CHARACTER HEIGHT---                      **
30917C               **  WRITE OUT A  T ( S SIZE-NUMBER )                **
30918C               **  WHERE SIZE-NUMBER IS FROM 0 TO 16               **
30919C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
30920C               **             PAGES 118                            **
30921C               ******************************************************
30922C
30923C     MARCH, 1991.  BASE ON VALUE OF JSIZE (DETERMINED IN GRTRSI).
30924 8100 CONTINUE
30925      ICSTR(1:3)='T(S'
30926      ICSTR(4:6)=' 0)'
30927      IF(JSIZE.GE.0.AND.JSIZE.LE.9)WRITE(ICSTR(5:5),'(I1)')JSIZE
30928      IF(JSIZE.GE.10.AND.JSIZE.LE.99)WRITE(ICSTR(4:5),'(I2)')JSIZE
30929      NCSTR=6
30930      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
30931      GOTO9000
30932C
30933C               ******************************************************
30934C               **  STEP 86--                                       **
30935C               **  TREAT THE POSTSCRIPT CASE                       **
30936C               **  CHARACTER SIZE DETERMINED BY POINT SIZE         **
30937C               **  OF FONT SELECTED.  FONT SELECTED IN "GRWRTH"    **
30938C               **  "GRWRTV".  NOTHING DONE HERE.                   **
30939C               **  REFERENCE--POSTSCRIPT LANGUAGE TUTORIAL AND     **
30940C               **             COOKBOOK, ADOBE SYSTEMS              **
30941C               ******************************************************
30942C
30943 8600 CONTINUE
30944      GOTO9000
30945C
30946C               ******************************************************
30947C               **  STEP 91--                                       **
30948C               **  TREAT THE QUIC       CASE                       **
30949C               **  CHARACTER SIZE DETERMINED BY POINT SIZE         **
30950C               **  OF FONT SELECTED.  FONT SELECTED IN "GRWRTH"    **
30951C               **  "GRWRTV".  NOTHING DONE HERE.                   **
30952C               **  REFERENCE--QUIC PROGRAMMERS MANUAL,             **
30953C               **             FROM QMS                             **
30954C               ******************************************************
30955C
30956 9100 CONTINUE
30957      GOTO9000
30958C
30959C               ******************************************************
30960C               **  STEP 96--                                       **
30961C               **  TREAT THE X11        CASE                       **
30962C               **  C LIBRARY WILL HANDLE SIZE AND JUSTIFICATION,   **
30963C               **  SO THIS WILL BE  A NULL ROUTINE                 **
30964C               ******************************************************
30965C
30966 9600 CONTINUE
30967      GOTO9000
30968C
30969C               *************************************************
30970C               **  STEP 100--                                 **
30971C               **  TREAT THE VGA VIA TURBO-C       CASE       **
30972C               **  DONE VIA settextstyle in GRWRTH & GRWRTV   **
30973C               *************************************************
30974C
3097510000 CONTINUE
30976CTURB CALL TCSESI(PHEIGH,PWIDTH,PVEGAP,PHOGAP)
30977      GOTO9000
30978C
30979C               ******************************************************
30980C               **  STEP 110--                                      **
30981C               **  TREAT THE GKS                DRIVER             **
30982C               ******************************************************
30983C
3098411000 CONTINUE
30985      GOTO9000
30986C
30987C               ******************************************************
30988C               **  STEP 120--                                      **
30989C               **  TREAT THE GD                     DRIVER         **
30990C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
30991C               **  1) JPEG                                         **
30992C               **  2) PNG                                          **
30993C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
30994C               ******************************************************
30995C
3099612000 CONTINUE
30997      GOTO9000
30998C
30999C               ******************************************************
31000C               **  STEP 130--                                      **
31001C               **  TREAT THE ABSOFT                 CASE           **
31002C               ******************************************************
31003C
3100413000 CONTINUE
31005      GOTO9000
31006C
31007C               ******************************************************
31008C               **  STEP 135--                                      **
31009C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
31010C               ******************************************************
31011C
3101213500 CONTINUE
31013COLD  CALL aqtSetFontsize(PHEIG2)
31014#ifdef HAVE_AQUA
31015      CALL aqsesi(PHEIG2)
31016#endif
31017      GOTO9000
31018C
31019C               ******************************************************
31020C               **  STEP 150--                                      **
31021C               **  TREAT THE LATEX                  DRIVER         **
31022C               ******************************************************
31023C
3102415000 CONTINUE
31025      IF(JSIZE.EQ.1)THEN
31026        ICSTR(1:1)=IBASLC
31027        ICSTR(2:5)='tiny'
31028        NCSTR=5
31029      ELSEIF(JSIZE.EQ.2)THEN
31030        ICSTR(1:1)=IBASLC
31031        ICSTR(2:11)='scriptsize'
31032        NCSTR=11
31033      ELSEIF(JSIZE.EQ.3)THEN
31034        ICSTR(1:1)=IBASLC
31035        ICSTR(2:13)='footnotesize'
31036        NCSTR=13
31037      ELSEIF(JSIZE.EQ.5)THEN
31038        ICSTR(1:1)=IBASLC
31039        ICSTR(2:6)='small'
31040        NCSTR=6
31041      ELSEIF(JSIZE.EQ.5)THEN
31042        ICSTR(1:1)=IBASLC
31043        ICSTR(2:11)='normalsize'
31044        NCSTR=11
31045      ELSEIF(JSIZE.EQ.6)THEN
31046        ICSTR(1:1)=IBASLC
31047        ICSTR(2:6)='large'
31048        NCSTR=6
31049      ELSEIF(JSIZE.EQ.7)THEN
31050        ICSTR(1:1)=IBASLC
31051        ICSTR(2:6)='Large'
31052        NCSTR=6
31053      ELSEIF(JSIZE.EQ.8)THEN
31054        ICSTR(1:1)=IBASLC
31055        ICSTR(2:6)='LARGE'
31056        NCSTR=6
31057      ELSEIF(JSIZE.EQ.9)THEN
31058        ICSTR(1:1)=IBASLC
31059        ICSTR(2:5)='huge'
31060        NCSTR=5
31061      ELSEIF(JSIZE.EQ.10)THEN
31062        ICSTR(1:1)=IBASLC
31063        ICSTR(2:5)='Huge'
31064        NCSTR=5
31065      ELSE
31066        ICSTR(1:1)=IBASLC
31067        ICSTR(2:11)='normalsize'
31068        NCSTR=11
31069      ENDIF
31070C
31071      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
31072      GOTO9000
31073C
31074C               ******************************************************
31075C               **  STEP 160--                                      **
31076C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
31077C               ******************************************************
31078C
3107916000 CONTINUE
31080      GOTO9000
31081C
31082C               ******************************************************
31083C               **  STEP 170--                                      **
31084C               **  TREAT THE CAIRO                          DRIVER **
31085C               ******************************************************
31086C
3108717000 CONTINUE
31088      GOTO9000
31089C
31090C               ******************************************************
31091C               **  STEP 180--                                      **
31092C               **  TREAT THE WMF                            DRIVER **
31093C               ******************************************************
31094C
3109518000 CONTINUE
31096      GOTO9000
31097C
31098C               ******************************************************
31099C               **  STEP 190--                                      **
31100C               **  TREAT THE D3                             DRIVER **
31101C               ******************************************************
31102C
3110319000 CONTINUE
31104      GOTO9000
31105C
31106C               *****************
31107C               **  STEP 90--  **
31108C               **  EXIT       **
31109C               *****************
31110C
31111 9000 CONTINUE
31112      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SESI')THEN
31113        WRITE(ICOUT,999)
31114        CALL DPWRST('XXX','BUG ')
31115        WRITE(ICOUT,9011)
31116 9011   FORMAT('***** AT THE END       OF GRSESI--')
31117        CALL DPWRST('XXX','BUG ')
31118        WRITE(ICOUT,9018)PVETO2,PHOTO2,IX,IY,NCSTR
31119 9018   FORMAT('PVETO2,PHOTO2,IX,IY,NCSTR = ',2G15.7,2X,3I8)
31120        CALL DPWRST('XXX','BUG ')
31121        IF(NCSTR.GT.0)THEN
31122          DO9025I=1,NCSTR
31123            CALL DPCOAN(ICSTR(I:I),IASCNE)
31124            WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE
31125 9026       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
31126            CALL DPWRST('XXX','BUG ')
31127 9025     CONTINUE
31128        ENDIF
31129      ENDIF
31130C
31131      RETURN
31132      END
31133      SUBROUTINE GRSETH(ICASE,PTHICK,JTHICK,PTHIC2)
31134C
31135C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, SET A THICKNESS
31136C              (E.G., A PEN THICKNESS) ON A SPECIFIC GRAPHICS DEVICE.
31137C
31138C     WRITTEN BY--JAMES J. FILLIBEN
31139C                 STATISTICAL ENGINEERING DIVISION
31140C                 INFORMATION TECHNOLOGY LABORATORY
31141C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
31142C                 GAITHERSBURG, MD 20899-8980
31143C                 PHONE--301-975-2855
31144C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
31145C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
31146C     LANGUAGE--ANSI FORTRAN (1977)
31147C     VERSION NUMBER--83.6
31148C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
31149C     UPDATED         --JANUARY   1989. SUN (BY BILL ANDERSON)
31150C                                       DRIVER OBSOLETE
31151C     UPDATED         --JANUARY   1989. POSTSCRIPT (BY ALAN HECKERT)
31152C     UPDATED         --JANUARY   1989. CGM (BY ALAN HECKERT)
31153C     UPDATED         --JANUARY   1989. QMS QUIC (BY ALAN HECKERT)
31154C     UPDATED         --JANUARY   1989. CALCOMP (BY ALAN HECKERT)
31155C     UPDATED         --JANUARY   1989. ZETA (BY ALAN HECKERT)
31156C     UPDATED         --MARCH     1990. X11 (BY ALAN HECKERT)
31157C     UPDATED         --MAY       1991. RENUMBER TOP BRANCHES (JJF)
31158C     UPDATED         --MAY       1991. VGA/TURBOC DRIVER (JJF)
31159C                                       DRIVER OBSOLETE
31160C     UPDATED         --JULY      1996. LAHEY DRIVER (ALAN HECKERT)
31161C                                       OLD STYLE CALCOMP
31162C                                       DRIVER OBSOLETE
31163C     UPDATED         --OCTOBER   1996. QUICKWIN DRIVER (ALAN)
31164C     UPDATED         --OCTOBER   1996. OPENGL DRIVER (ALAN)
31165C                                       USE BILL MITCHELLS OPENGL
31166C                                       BINDING FOR FORTRAN
31167C     UPDATED         --OCTOBER   1996. GKS (ALAN)
31168C                                       CODED, NOT TESTED
31169C     UPDATED         --OCTOBER   1996. BINARY CGM (ALAN)
31170C                                       PLACEHOLDER FOR NOW
31171C     UPDATED         --OCTOBER   1996. DISPLAY POSTSCRIPT (ALAN)
31172C                                       PLACEHOLDER FOR NOW
31173C     UPDATED         --OCTOBER   1997. LAHEY INTERACTOR (ALAN)
31174C     UPDATED         --JULY      1998. LAHEY WINTERACTOR
31175C     UPDATED         --JUNE      2000. GD (FOR JPEG, PNG, WINDOWS BMP)
31176C     UPDATED         --JUNE      2000. MACINTOSH
31177C                                       PLACEHOLDER FOR NOW
31178C     UPDATED         --JUNE     2000.  PC PRINTER
31179C                                       PLACEHOLDER FOR NOW
31180C     UPDATED         --FEBRUARY  2006. SUPPORT FOR LATEX
31181C     UPDATED         --SEPTEMBER 2007. SUPPORT FOR AQUATERM
31182C     UPDATED         --APRIL     2009. IMPLEMENT LIBPLOT DRIVER
31183C     UPDATED         --APRIL     2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
31184C                                       (THESE WERE NEVER ACTUALLY IMPLEMENTED)
31185C     UPDATED         --OCTOBER   2016. ADD PRE-PROCESSOR DIRECTIVES
31186C     UPDATED         --OCTOBER   2016. ADD TEMPLATES FOR SEVERL FUTURE
31187C                                       GRAPHICS DEVICES
31188C
31189C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
31190C
31191      CHARACTER*4 ICASE
31192      CHARACTER*130 ICSTR
31193      CHARACTER*4 ISUBN0
31194C
31195      DIMENSION XPATT(8)
31196C
31197C-----COMMON----------------------------------------------------------
31198C
31199      INCLUDE 'DPCOGR.INC'
31200      INCLUDE 'DPCONP.INC'
31201      INCLUDE 'DPCOBE.INC'
31202      INCLUDE 'DPCOST.INC'
31203      INCLUDE 'DPCODV.INC'
31204      INCLUDE 'DPCOP2.INC'
31205C
31206C-----START POINT-----------------------------------------------------
31207C
31208      ISUBN0='SETH'
31209      IERRG4='NO'
31210C
31211      NCSTR=(-999)
31212C
31213      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SETH')THEN
31214        WRITE(ICOUT,999)
31215  999   FORMAT(1X)
31216        CALL DPWRST('XXX','BUG ')
31217        WRITE(ICOUT,51)
31218   51   FORMAT('***** AT THE BEGINNING OF GRSETH--')
31219        CALL DPWRST('XXX','BUG ')
31220        WRITE(ICOUT,54)ICASE,IBUGG4,IMANUF,IMODEL
31221   54   FORMAT('ICASE,IBUGG4,IMANUF,IMODEL = ',3(A4,2X),A4)
31222        CALL DPWRST('XXX','BUG ')
31223        WRITE(ICOUT,56)PTHICK,JTHICK
31224   56   FORMAT('PTHICK,JTHICK = ',G15.7,I8)
31225        CALL DPWRST('XXX','BUG ')
31226      ENDIF
31227C
31228C               ********************************************
31229C               **  STEP 1--                              **
31230C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
31231C               **  AND THE MODEL                         **
31232C               ********************************************
31233C
31234      IF(IMANUF.EQ.'QWIN')THEN
31235        GOTO4700
31236      ELSEIF(IMANUF.EQ.'POST')THEN
31237        GOTO8600
31238      ELSEIF(IMANUF.EQ.'X11 ')THEN
31239        GOTO9600
31240      ELSEIF(IMANUF.EQ.'AQUA')THEN
31241        GOTO13500
31242      ELSEIF(IMANUF.EQ.'GENE')THEN
31243        IF(IMODEL.EQ.'CODE')GOTO3200
31244        IF(IMODEL.EQ.'CGM')GOTO3300
31245        IF(IMODEL.EQ.'CGMB')GOTO3400
31246        GOTO3100
31247      ELSEIF(IMANUF.EQ.'SVG ')THEN
31248        GOTO16000
31249      ELSEIF(IMANUF.EQ.'GD  ')THEN
31250        GOTO12000
31251      ELSEIF(IMANUF.EQ.'LATE')THEN
31252        GOTO15000
31253      ELSEIF(IMANUF.EQ.'CAIR')THEN
31254        GOTO17000
31255      ELSEIF(IMANUF.EQ.'D3  ')THEN
31256        GOTO19000
31257      ELSEIF(IMANUF.EQ.'WMF ')THEN
31258        GOTO18000
31259      ELSEIF(IMANUF.EQ.'OPGL')THEN
31260        GOTO4800
31261      ELSEIF(IMANUF.EQ.'TEKT')THEN
31262        GOTO1100
31263      ELSEIF(IMANUF.EQ.'HP')THEN
31264        IF(IMODEL.EQ.'7221')GOTO2100
31265        IF(IMODEL.EQ.'2622')GOTO2300
31266        IF(IMODEL.EQ.'2623')GOTO2300
31267        IF(IMODEL.EQ.'2627')GOTO2300
31268        IF(IMODEL.EQ.'2647')GOTO2300
31269        GOTO2200
31270      ELSEIF(IMANUF.EQ.'LIBP')THEN
31271        GOTO2600
31272      ELSEIF(IMANUF.EQ.'REGI')THEN
31273        GOTO8100
31274      ELSEIF(IMANUF.EQ.'GKS ')THEN
31275        GOTO11000
31276      ELSEIF(IMANUF.EQ.'LAHE')THEN
31277        IF(IMODEL.EQ.'INTE')GOTO4900
31278        IF(IMODEL.EQ.'WINT')GOTO4950
31279        GOTO4600
31280      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
31281        GOTO13000
31282      ELSEIF(IMANUF.EQ.'QUIC')THEN
31283        GOTO9100
31284      ELSEIF(IMANUF.EQ.'CALC')THEN
31285        GOTO4100
31286      ELSEIF(IMANUF.EQ.'ZETA')THEN
31287        GOTO5100
31288      ELSEIF(IMANUF.EQ.'TURB')THEN
31289        GOTO10000
31290      ELSEIF(IMANUF.EQ.'SUN ')THEN
31291        GOTO6600
31292      ENDIF
31293      GOTO9000
31294C
31295C               ******************************************************
31296C               **  STEP 11--                                       **
31297C               **  TREAT THE TEKTRONIX CASE                        **
31298C               **  REFERENCE--XXX                                  **
31299C               ******************************************************
31300C
31301 1100 CONTINUE
31302      GOTO9000
31303C
31304C               ******************************************************
31305C               **  STEP 21--                                       **
31306C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
31307C               **  (MULTI-COLOR PENPLOTTER)                        **
31308C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
31309C               **             OPERATING AND PROGRAMMING MANUAL,    **
31310C               **             PAGE XX.                             **
31311C               ******************************************************
31312C
31313 2100 CONTINUE
31314      GOTO9000
31315C
31316C               ******************************************************
31317C               **  STEP 22--                                       **
31318C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
31319C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
31320C               **  (MULTI-COLOR PENPLOTTERS)                       **
31321C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
31322C               **             OPERATING AND PROGRAMMING MANUAL,    **
31323C               **             PAGE XX, XXX.                        **
31324C               ******************************************************
31325C
31326 2200 CONTINUE
31327      GOTO9000
31328C
31329C               ******************************************************
31330C               **  STEP 23--                                       **
31331C               **  TREAT THE HEWLETT-PACKARD 2622  CASES           **
31332C               **  LINE THICKNESS IMPLEMENTED IN SOFTWARE          **
31333C               ******************************************************
31334C
31335 2300 CONTINUE
31336      GOTO9000
31337C
31338C               **********************************************************
31339C               **  STEP 26--                                           **
31340C               **  TREAT THE UNIX LIBPLOT            CASE              **
31341C               **********************************************************
31342C
31343 2600 CONTINUE
31344      INDEX=1
31345      ICODE=0
31346      AVAL=PTHICK
31347#ifdef HAVE_LIBPLOT
31348      CALL PLLATR(INDEX,ICODE,DBLE(AVAL))
31349#endif
31350      GOTO9000
31351C
31352C               ******************************************************
31353C               **  STEP 31--                                       **
31354C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
31355C               ******************************************************
31356C
31357C  JANUARY, 1988: TWO SET COMMANDS FOR LINE THICKNESS.
31358C  SET THICKNESS <ON/OFF> - IF OFF, LINE WIDTH IS SET TO THE
31359C                           REQUESTED VALUE, UP TO THE POST PROCESSOR
31360C                           TO IMPLEMENT MULTIPLE WIDTH LINES.
31361C                           IF ON, MULTIPLE LINE WIDTH WILL BE IMPLEMENTED
31362C                           WITHIN DATAPLOT.  THE LINE WIDTH FOR A
31363C                           SINGLE LINE DETERMINED BY NEXT COMMAND.
31364C  SET PEN WIDTH <WIDTH> - SETS PEN WIDTH TO BE USED IN IMPLEMENTING
31365C                          MULTIPLE LINE WIDTH WITHIN DATAPLOT (0.1 DEFAULT)
31366 3100 CONTINUE
31367C
31368      IF(IPTHSW.EQ.'ON')THEN
31369        ICSTR(1:14)='SET THICKNESS '
31370        NCSTR=14
31371        NCHTOT=10
31372        NCHDEC=5
31373        CALL GRTRRE(PPENSW,NCHTOT,NCHDEC,ICSTR,NCSTR)
31374        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
31375      ELSE
31376        ICSTR(1:14)='SET THICKNESS '
31377        NCSTR=14
31378        NCHTOT=10
31379        NCHDEC=5
31380        CALL GRTRRE(PTHIC2,NCHTOT,NCHDEC,ICSTR,NCSTR)
31381        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
31382      ENDIF
31383      GOTO9000
31384C
31385C               ***************************************************************
31386C               **  STEP 32--                                                **
31387C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
31388C               ***************************************************************
31389C
31390C  JANUARY, 1988: TWO SET COMMANDS FOR LINE THICKNESS.
31391C  SET THICKNESS <ON/OFF> - IF OFF, LINE WIDTH IS SET TO THE
31392C                           REQUESTED VALUE, UP TO THE POST PROCESSOR
31393C                           TO IMPLEMENT MULTIPLE WIDTH LINES.
31394C                           IF ON, MULTIPLE LINE WIDTH WILL BE IMPLEMENTED
31395C                           WITHIN DATAPLOT.  THE LINE WIDTH FOR A
31396C                           SINGLE LINE DETERMINED BY NEXT COMMAND.
31397C  SET PEN WIDTH <WIDTH> - SETS PEN WIDTH TO BE USED IN IMPLEMENTING
31398C                          MULTIPLE LINE WIDTH WITHIN DATAPLOT (0.1 DEFAULT)
31399 3200 CONTINUE
31400C
31401      IF(IPTHSW.EQ.'ON')THEN
31402        ICSTR(1:5)='SETH '
31403        NCSTR=5
31404        NCHTOT=10
31405        NCHDEC=5
31406        CALL GRTRRE(PPENSW,NCHTOT,NCHDEC,ICSTR,NCSTR)
31407        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
31408      ELSE
31409        ICSTR(1:5)='SETH '
31410        NCSTR=5
31411        NCHTOT=10
31412        NCHDEC=5
31413        CALL GRTRRE(PTHIC2,NCHTOT,NCHDEC,ICSTR,NCSTR)
31414        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
31415      ENDIF
31416      GOTO9000
31417C
31418C               ******************************************************
31419C               **  STEP 33--                                       **
31420C               **  TREAT THE CGM            CASE                   **
31421C               **  LINEWIDTH <NUMBER>                              **
31422C               **  NOTE THAT LINE WIDTH SPECIFICATION MODE IS SET  **
31423C               **  TO ABSOLUTE IN "GRINDE".  THIS CORRESPONDS TO   **
31424C               **  THE DATAPLOT MEANING (I.E., 0.1 IS A PERCENTAGE **
31425C               **  OF THE TOTAL (100 PER CENT) VERTICAL SIZE OR    **
31426C               **  VDC UNITS.                                      **
31427C               **  NOTE: THE ABSOLUTE MODE DESCRIBED IN THE STANDARD*
31428C               **        DOES NOT SEEM TO BE SUPPORTED.  THERE IS  **
31429C               **        AN "ABSTRACT" MODE, BUT I CAN NOT FIND    **
31430C               **        DOCUMENTATION ON WHAT THIS MEANS.  IT MAY **
31431C               **        BE A REPLACEMENT FOR ABSOLUTE, BUT I AM   **
31432C               **        NOT SURE.  FOR NOW, USE SCALED MODE WHICH **
31433C               **        SPECIFIES LINE WIDTH AS A MULTIPLE OF THE **
31434C               **        NOMINAL DEVICE LINE WIDTH.                **
31435C               ******************************************************
31436C
31437 3300 CONTINUE
31438C
31439      IF(IPTHSW.EQ.'ON')THEN
31440        ICSTR(1:14)='LINEWIDTH 1.0;'
31441        NCSTR=14
31442        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
31443      ELSE
31444        ICSTR(1:10)='LINEWIDTH '
31445        NCSTR=10
31446        ASCALE=PTHIC2/PPENSW
31447        NCHTOT=10
31448        NCHDEC=5
31449        CALL GRTRRE(ASCALE,NCHTOT,NCHDEC,ICSTR,NCSTR)
31450        ICSTR(21:21)=';'
31451        NCSTR=21
31452        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
31453      ENDIF
31454      GOTO9000
31455C
31456C               ***************************************************
31457C               **  STEP 34--                                    **
31458C               **  TREAT THE CGM (BINARY)                 CASE  **
31459C               ***************************************************
31460C
31461 3400 CONTINUE
31462      GOTO9000
31463C
31464C               ******************************************************
31465C               **  STEP 41--                                       **
31466C               **  TREAT THE CALCOMP XXXXXX CASE                   **
31467C               **  LINE THICKNESS IS IMPLEMENTED IN SOFTWARE       **
31468C               **  REFERENCE--XX                                   **
31469C               **             XX                                   **
31470C               **             PAGES XX AND XX                      **
31471C               ******************************************************
31472C
31473 4100 CONTINUE
31474      GOTO9000
31475C
31476C               ******************************************************
31477C               **  STEP 46--                                       **
31478C               **  TREAT THE LAHEY   XXXXXX CASE                   **
31479C               **  REFERENCE--Programmer's Reference, Revision C   **
31480C               **             Lahey Computer Systems, January, 1992**
31481C               **             PAGES 51 THRU 65                     **
31482C               ******************************************************
31483C
31484 4600 CONTINUE
31485      GOTO9000
31486C
31487C               ******************************************************
31488C               **  STEP 47--                                       **
31489C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
31490C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
31491C               ******************************************************
31492C
31493 4700 CONTINUE
31494      GOTO9000
31495C
31496C               ******************************************************
31497C               **  STEP 48--                                       **
31498C               **  TREAT THE OPEN-GL DRIVER                        **
31499C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
31500C               ******************************************************
31501C
31502 4800 CONTINUE
31503      IF(IOPGOF.EQ.'OFF')GOTO9000
31504      ICODE=1
31505      ISTYLE=0
31506#ifdef HAVE_OPENGL
31507      CALL GLATTR(ICODE,ISTYLE,PTHIC2)
31508#endif
31509      GOTO9000
31510C
31511C               ******************************************************
31512C               **  STEP 49--                                       **
31513C               **  TREAT THE LAHEY INTERACTOR CASE                 **
31514C               ******************************************************
31515C
31516 4900 CONTINUE
31517      GOTO9000
31518C
31519C               ******************************************************
31520C               **  STEP 49B-                                       **
31521C               **  TREAT THE LAHEY WINTERACTOR CASE                **
31522C               ******************************************************
31523C
31524 4950 CONTINUE
31525      GOTO9000
31526C
31527C
31528C               ******************************************************
31529C               **  STEP 51--                                       **
31530C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
31531C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
31532C               **             MODELS 3600SX AND 3653SX             **
31533C               **             PAGES B-0 AND B-1                    **
31534C               ******************************************************
31535C
31536 5100 CONTINUE
31537      GOTO9000
31538C
31539C               ******************************************************
31540C               **  STEP 66--                                       **
31541C               **  TREAT THE SUN           CASE                    **
31542C               ******************************************************
31543C
31544 6600 CONTINUE
31545#ifdef HAVE_SUN
31546      CALL cflnwidth(pthick)
31547#endif
31548      GOTO9000
31549C
31550C               ******************************************************
31551C               **  STEP 81--                                       **
31552C               **  TREAT THE REGIS         CASE                    **
31553C               ******************************************************
31554C
31555 8100 CONTINUE
31556      GOTO9000
31557C
31558C               ******************************************************
31559C               **  STEP 86--                                       **
31560C               **  TREAT THE POSTSCRIPT    CASE                    **
31561C               **  <NUMBER> SETLINEWIDTH                           **
31562C               ******************************************************
31563C
31564 8600 CONTINUE
31565      NCHTOT=5
31566      NCSTR=0
31567      ITEMP=INT(PTHIC2)
31568      CALL GRTRIN(ITEMP,NCHTOT,ICSTR,NCSTR)
31569      ICSTR(6:18)=' setlinewidth'
31570      NCSTR=18
31571      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
31572      GOTO9000
31573C
31574C               ******************************************************
31575C               **  STEP 91--                                       **
31576C               **  TREAT THE QUIC          CASE                    **
31577C               **  FOR QUIC, THE PEN WIDTH IS SET ONLY AFTER       **
31578C               **  VECTOR GRAPHICS MODE IS ENTERED IN "GRDRLI" OR  **
31579C               **  "GRDRPL".  NOTHING DONE HERE                    **
31580C               ******************************************************
31581C
31582 9100 CONTINUE
31583      GOTO9000
31584C
31585C               ******************************************************
31586C               **  STEP 96--                                       **
31587C               **  TREAT THE X11           CASE                    **
31588C               ******************************************************
31589C
31590 9600 CONTINUE
31591#ifdef HAVE_X11
31592      IF(IX11OF.EQ.'OFF')GOTO9000
31593      ICODE=1
31594      INDEX=INT(PTHIC2+0.5)
31595      CALL XLATTR(INDEX,ICODE)
31596#endif
31597      GOTO9000
31598C
31599CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
31600C               *************************************************
31601C               **  STEP 100--                                 **
31602C               **  TREAT THE VGA VIA TURBO-C       CASE       **
31603C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
31604C               **             ENHANCEMENTS, PAGE 124.         **
31605C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
31606C               **             PAGE 320-321.                   **
31607C               **  REFERENCE--WEISKAMP, POWER GRAPHICS        **
31608C               **             USING TURBO C, PAGE 30.         **
31609C               *************************************************
31610C
3161110000 CONTINUE
31612CTURB CALL TCSETH(PTHICK)
31613      GOTO9000
31614C
31615C               ******************************************************
31616C               **  STEP 110--                                      **
31617C               **  TREAT THE GKS                DRIVER             **
31618C               ******************************************************
31619C
3162011000 CONTINUE
31621      GOTO9000
31622C
31623C               ******************************************************
31624C               **  STEP 120--                                      **
31625C               **  TREAT THE GD                     DRIVER         **
31626C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
31627C               **  1) JPEG                                         **
31628C               **  2) PNG                                          **
31629C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
31630C               **  LINE THICKNESS HANDLED IN SOFTWARE              **
31631C               ******************************************************
31632C
3163312000 CONTINUE
31634      GOTO9000
31635C
31636C               ******************************************************
31637C               **  STEP 130--                                      **
31638C               **  TREAT THE ABSOFT                 DRIVER         **
31639C               ******************************************************
31640C
3164113000 CONTINUE
31642      GOTO9000
31643C
31644C               ******************************************************
31645C               **  STEP 135--                                      **
31646C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
31647C               ******************************************************
31648C
3164913500 CONTINUE
31650COLD  CALL aqtSetLinewidth(PTHIC2)
31651      NPATT=0
31652      DO13501I=1,8
31653        XPATT(I)=-1.0
3165413501 CONTINUE
31655      IOPT=2
31656#ifdef HAVE_AQUA
31657      CALL aqsepa(XPATT,NPATT,PTHIC2,IOPT)
31658#endif
31659      GOTO9000
31660C
31661C
31662C               ******************************************************
31663C               **  STEP 150--                                      **
31664C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
31665C               ******************************************************
31666C
3166715000 CONTINUE
31668      IF(ILATLT.EQ.'HARD')THEN
31669        IF(PTHIC2.GE.0.25)THEN
31670          ICSTR(1:1)=IBASLC
31671          ICSTR(2:11)='Thicklines'
31672          NCSTR=11
31673          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
31674        ELSEIF(PTHIC2.GE.0.15)THEN
31675          ICSTR(1:1)=IBASLC
31676          ICSTR(2:11)='thicklines'
31677          NCSTR=11
31678          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
31679        ELSE
31680          ICSTR(1:1)=IBASLC
31681          ICSTR(2:10)='thinlines'
31682          NCSTR=10
31683          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
31684        ENDIF
31685      ENDIF
31686      GOTO9000
31687C
31688C               ******************************************************
31689C               **  STEP 160--                                      **
31690C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
31691C               ******************************************************
31692C
3169316000 CONTINUE
31694      GOTO9000
31695C
31696C               ******************************************************
31697C               **  STEP 170--                                      **
31698C               **  TREAT THE CAIRO                          DRIVER **
31699C               ******************************************************
31700C
3170117000 CONTINUE
31702      GOTO9000
31703C
31704C               ******************************************************
31705C               **  STEP 180--                                      **
31706C               **  TREAT THE WMF                            DRIVER **
31707C               ******************************************************
31708C
3170918000 CONTINUE
31710      GOTO9000
31711C
31712C               ******************************************************
31713C               **  STEP 190--                                      **
31714C               **  TREAT THE D3                             DRIVER **
31715C               ******************************************************
31716C
3171719000 CONTINUE
31718      GOTO9000
31719C
31720C               *****************
31721C               **  STEP 90--  **
31722C               **  EXIT       **
31723C               *****************
31724C
31725 9000 CONTINUE
31726      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SETH')THEN
31727        WRITE(ICOUT,999)
31728        CALL DPWRST('XXX','BUG ')
31729        WRITE(ICOUT,9011)
31730 9011   FORMAT('***** AT THE END       OF GRSETH--')
31731        CALL DPWRST('XXX','BUG ')
31732        WRITE(ICOUT,9019)IERRG4
31733 9019   FORMAT('IERRG4 = ',A4)
31734        CALL DPWRST('XXX','BUG ')
31735      ENDIF
31736C
31737      RETURN
31738      END
31739      SUBROUTINE GRTRCA(ITYPE,ICASE,JCASE)
31740C
31741C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, TRANSLATE A CASE
31742C              (UPPER OR LOWER) GIVEN IN CHARACTER REPRESENTATI INTO A
31743C              NUMERIC REPRESENTATION THAT WILL BE UNDERSTOOD BY A
31744C              SPECIFIC GRAPHICS DEVICE.
31745C
31746C     WRITTEN BY--JAMES J. FILLIBEN
31747C                 STATISTICAL ENGINEERING DIVISION
31748C                 INFORMATION TECHNOLOGY LABORATORY
31749C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
31750C                 GAITHERSBURG, MD 20899-8980
31751C                 PHONE--301-975-2855
31752C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
31753C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
31754C     LANGUAGE--ANSI FORTRAN (1977)
31755C     VERSION NUMBER--83.6
31756C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
31757C     UPDATED         --APRIL    2009. THIS CODE DOES NOT CONTAIN ANY
31758C                                      DEVICE SPECIFIC CODE, SO REMOVE
31759C                                      DEVICE DEPENDENT BRANCHES
31760C
31761C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
31762C
31763      CHARACTER*4 ITYPE
31764      CHARACTER*4 ICASE
31765C
31766C-----COMMON----------------------------------------------------------
31767C
31768      INCLUDE 'DPCOGR.INC'
31769      INCLUDE 'DPCOBE.INC'
31770      INCLUDE 'DPCOP2.INC'
31771C
31772C-----START POINT-----------------------------------------------------
31773C
31774      IERRG4='NO'
31775C
31776      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRCA')THEN
31777        WRITE(ICOUT,999)
31778  999   FORMAT(1X)
31779        CALL DPWRST('XXX','BUG ')
31780        WRITE(ICOUT,51)
31781   51   FORMAT('***** AT THE BEGINNING OF GRTRCA--')
31782        CALL DPWRST('XXX','BUG ')
31783        WRITE(ICOUT,52)ITYPE,ICASE,IMANUF,IMODEL,IBUGG4
31784   52   FORMAT('ITYPE,ICASE,IMANUF,IMODEL,IBUGG4 = ',4(A4,2X),A4)
31785        CALL DPWRST('XXX','BUG ')
31786      ENDIF
31787C
31788C               *************************************
31789C               **  STEP 0--                       **
31790C               **  DEFINE CASE                    **
31791C               **  FOR A GENERAL GRAPHICS DEVICE  **
31792C               *************************************
31793C
31794      JCASE=1
31795      IF(ICASE.EQ.'UPPE')JCASE=1
31796      IF(ICASE.EQ.'LOWE')JCASE=2
31797C
31798C               *****************
31799C               **  STEP 90--  **
31800C               **  EXIT       **
31801C               *****************
31802C
31803      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRCA')THEN
31804        WRITE(ICOUT,999)
31805        CALL DPWRST('XXX','BUG ')
31806        WRITE(ICOUT,9011)
31807 9011   FORMAT('***** AT THE END       OF GRTRCA--')
31808        CALL DPWRST('XXX','BUG ')
31809        WRITE(ICOUT,9019)IERRG4
31810 9019   FORMAT('IERRG4 = ',A4)
31811        CALL DPWRST('XXX','BUG ')
31812      ENDIF
31813C
31814      RETURN
31815      END
31816      SUBROUTINE GRTRCO(ICASE,ICOL,JCOL)
31817C
31818C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, TRANSLATE A COLOR
31819C              GIVEN IN CHARACTER REPRESENTATION INTO A NUMERIC
31820C              REPRESENTATION THAT WILL BE UNDERSTOOD BY A SPECIFIC
31821C              GRAPHICS DEVICE.
31822C     NOTE--THIS SUBROUTINE IS NEEDED FOR COLOR DEVICES ONLY.
31823C
31824C     WRITTEN BY--JAMES J. FILLIBEN
31825C                 STATISTICAL ENGINEERING DIVISION
31826C                 INFORMATION TECHNOLOGY LABORATORY
31827C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
31828C                 GAITHERSBURG, MD 20899-8980
31829C                 PHONE--301-975-2855
31830C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
31831C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
31832C     LANGUAGE--ANSI FORTRAN (1977)
31833C     VERSION NUMBER--83.6
31834C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
31835C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
31836C                                      DRIVER OBSOLETE
31837C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
31838C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
31839C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
31840C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
31841C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
31842C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
31843C     UPDATED         --MAY      1990. PEN MAP FOR HPGL, ZETA, CALCOMP (ALAN)
31844C     UPDATED         --JULY     1990. SOME HP-26XX TERMINALS SUPPORT COLOR
31845C     UPDATED         --AUGUST   1990. SUPPORT GRAYSCALE ON POSTSCRIPT (ALAN)
31846C     UPDATED         --JANUARY  1991. ADD COLOR SUPPORT FOR REGIS (ALAN)
31847C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
31848C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
31849C                                      DRIVER OBSOLETE
31850C     UPDATED         --JUNE     1991. ADDITIONAL COLOR SUPPORT FOR X11 (ALAN)
31851C     UPDATED         --AUGUST   1992. SIGNIFICANT CHANGES TO SUPPORT A
31852C                                      CONSISTENT SET OF COLORS AND
31853C                                      INDICES (ALAN)
31854C                                      ALSO MAKE TABLE-DRIVEN FOR
31855C                                      BETTER EFFICIENCY.
31856C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
31857C                                      OLD CALCOMP STYLE
31858C                                      DRIVER OBSOLETE
31859C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
31860C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
31861C                                      USE BILL MITCHELLS OPENGL
31862C                                      BINDING FOR FORTRAN
31863C     UPDATED         --OCTOBER  1996. GKS (ALAN)
31864C                                      CODED, NOT TESTED
31865C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
31866C                                      PLACEHOLDER FOR NOW
31867C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
31868C                                      PLACEHOLDER FOR NOW
31869C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
31870C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
31871C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
31872C     UPDATED         --JUNE     2000. MACINTOSH
31873C                                      PLACEHOLDER FOR NOW
31874C     UPDATED         --JUNE     2000. PC PRINTER
31875C                                      PLACEHOLDER FOR NOW
31876C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
31877C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
31878C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
31879C     UPDATED         --APRIL    2009. IMPLEMENT LIBPLOT DRIVER
31880C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
31881C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
31882C     UPDATED         --MAY      2012. ADD SUPPORT FOR:
31883C                                         R0 - R255
31884C                                         B0 - B255
31885C                                         G0 - G255
31886C                                      THIS ADDS SHADING TO PRIMRY COLORS
31887C                                      SIMILAR TO GRAY SCALE.  A BIT OF A
31888C                                      STOP GAP TO IMPLEMENTING FULL RGB
31889C                                      SUPPORT.
31890C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
31891C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
31892C                                      GRAPHICS DEVICES
31893C
31894C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
31895C
31896      CHARACTER*4 ICASE
31897      CHARACTER*4 ICOL
31898      CHARACTER*4 CJUNK
31899C
31900      PARAMETER (MAXCLR=89)
31901      CHARACTER*4 ICOLNM(MAXCLR)
31902C
31903      INTEGER J4027(MAXCLR)
31904      INTEGER J4105(MAXCLR)
31905      INTEGER JPLOT4(MAXCLR)
31906      INTEGER JPLOT8(MAXCLR)
31907      INTEGER J2622(MAXCLR)
31908      INTEGER JCGM(MAXCLR)
31909      INTEGER JSUN(MAXCLR)
31910      INTEGER JX11(MAXCLR)
31911      INTEGER JREGIS(MAXCLR)
31912      INTEGER JPC(MAXCLR)
31913      INTEGER JLAHEY(MAXCLR)
31914      INTEGER JWINT(MAXCLR)
31915C
31916      CHARACTER*4 ISUBN0
31917C
31918C-----COMMON----------------------------------------------------------
31919C
31920      INCLUDE 'DPCOGR.INC'
31921      INCLUDE 'DPCONP.INC'
31922      INCLUDE 'DPCOBE.INC'
31923      INCLUDE 'DPCODV.INC'
31924      INCLUDE 'DPCOP2.INC'
31925C
31926C  AUGUST 1992.  DEFINE COLOR TABLES.
31927C
31928C  ROW 1: WHIT, BLAC, RED , BLUE, GREE, MAGE, ORAN, CYAN, YELL, YGRE
31929C  ROW 2: DGRE, LBLU, VBLU, VRED, DGRA, LGRA, AQUA, BROW, CABL, CORA
31930C  ROW 3: CBLU, DOGR, DORC, DSBL, DTUR, FIRE, FGRE, GOLD, GLDR, GRAY
31931C  ROW 4: IRED, KHAK, DMGR, LSBL, LGRE, MARO, MAQU, MBLU, MFGR, MGLD
31932C  ROW 5: MORC, MSGR, MSBL, MSPG, MTUR, MVRD, MDBL, NAVY, ORED, ORCH
31933C  ROW 6: PGRE, PINK, PLUM, PURP, SALM, SGRE, SIEN, SKBL, SBLU, SPGR
31934C  ROW 7: STBL, TAN , THIS, TURQ, VIOL, WHEA, GYEL, LCYA, BLU2, BLU3
31935C  ROW 8: BLU4, CYA2, CYA3, CYA4, GRE2, GRE3, GRE4, YEL2, YEL3, YEL4
31936C  ROW 9: ORA2, ORA3, ORA4, RED2, RED3, RED4, MAG1, MAG2, MAG3
31937C
31938      DATA (ICOLNM(I),I=1,50)/
31939     1 'WHIT', 'BLAC', 'RED ', 'BLUE', 'GREE', 'MAGE', 'ORAN', 'CYAN',
31940     X 'YELL', 'YGRE',
31941     2 'DGRE', 'LBLU', 'VBLU', 'VRED', 'DGRA', 'LGRA', 'AQUA', 'BROW',
31942     X 'CABL', 'CORA',
31943     3 'CBLU', 'DOGR', 'DORC', 'DSBL', 'DTUR', 'FIRE', 'FGRE', 'GOLD',
31944     X 'GLDR', 'GRAY',
31945     4 'IRED', 'KHAK', 'DMGR', 'LSBL', 'LGRE', 'MARO', 'MAQU', 'MBLU',
31946     X 'MFGR', 'MGLD',
31947     5 'MORC', 'MSGR', 'MSBL', 'MSPG', 'MTUR', 'MVRD', 'MDBL', 'NAVY',
31948     X 'ORED', 'ORCH'/
31949      DATA (ICOLNM(I),I=51,MAXCLR)/
31950     6 'PGRE', 'PINK', 'PLUM', 'PURP', 'SALM', 'SGRE', 'SIEN', 'SKBL',
31951     X 'SBLU', 'SPGR',
31952     7 'STBL', 'TAN ', 'THIS', 'TURQ', 'VIOL', 'WHEA', 'GYEL', 'LCYA',
31953     X 'BLU2', 'BLU3',
31954     8 'BLU4', 'CYA2', 'CYA3', 'CYA4', 'GRE2', 'GRE3', 'GRE4', 'YEL2',
31955     X 'YEL3', 'YEL4',
31956     9 'ORA2', 'ORA3', 'ORA4', 'RED2', 'RED3', 'RED4', 'MAG2', 'MAG3',
31957     X 'MAG4'/
31958C
31959C  TEKTRONIX 4027
31960C
31961C  WHITE   = 0
31962C  RED     = 1
31963C  GREEN   = 2
31964C  BLUE    = 3
31965C  YELLOW  = 4
31966C  ORANGE  = 5
31967C  PURPLE  = 6
31968C  BLACK   = 7
31969C
31970      DATA (J4027(I),I=1,MAXCLR)/
31971     1  0,  7,  1,  3,  2,  6,  5,  3,  4,  4,
31972     2  2,  3,  3,  1,  7,  0,  3,  5,  3,  1,
31973     3  3,  2,  6,  3,  6,  4,  2,  4,  4,  7,
31974     4  1,  4,  0,  3,  2,  1,  3,  3,  2,  4,
31975     5  6,  2,  3,  2,  6,  6,  3,  3,  5,  6,
31976     6  2,  1,  6,  6,  4,  2,  6,  3,  3,  2,
31977     7  3,  4,  4,  6,  6,  4,  2,  3,  3,  3,
31978     8  3,  3,  3,  3,  2,  2,  2,  4,  4,  4,
31979     9  5,  5,  5,  1,  1,  1,  6,  6,  6/
31980C  TEKTRONIX 4105, GENERAL, GENERAL CODED
31981C
31982C  BLACK  = 0
31983C  WHITE  = 1
31984C  RED    = 2
31985C  GREEN  = 3
31986C  BLUE   = 4
31987C  CYAN   = 5
31988C  MAGENTA= 6
31989C  YELLOW = 7
31990C
31991      DATA (J4105(I),I=1,MAXCLR)/
31992     1  1,  0,  2,  4,  3,  6,  2,  5,  7,  7,
31993     2  3,  4,  4,  2,  0,  1,  4,  2,  4,  2,
31994     3  4,  3,  6,  4,  6,  7,  3,  7,  7,  0,
31995     4  2,  7,  1,  4,  3,  2,  4,  4,  3,  7,
31996     5  6,  3,  4,  3,  6,  6,  4,  4,  2,  6,
31997     6  3,  2,  6,  6,  7,  3,  6,  4,  4,  3,
31998     7  4,  7,  7,  6,  6,  7,  3,  5,  4,  4,
31999     8  4,  5,  5,  5,  3,  3,  3,  7,  7,  7,
32000     9  7,  7,  7,  2,  2,  2,  6,  6,  6/
32001C
32002C  PLOTTERS WITH 4 PENS (TEKTRONIX 4662, HP-7221, CALCOMP, ZETA, HP-GL)
32003C
32004C  BLACK   = 1
32005C  RED     = 2
32006C  BLUE    = 3
32007C  GREEN   = 4
32008C
32009      DATA (JPLOT4(I),I=1,MAXCLR)/
32010     1  1,  1,  2,  3,  4,  4,  2,  3,  2,  2,
32011     2  4,  3,  3,  2,  1,  1,  3,  2,  3,  2,
32012     3  3,  4,  2,  3,  2,  2,  4,  2,  2,  1,
32013     4  2,  2,  1,  3,  4,  2,  3,  3,  4,  2,
32014     5  2,  4,  3,  4,  2,  2,  3,  3,  2,  2,
32015     6  4,  2,  2,  2,  2,  4,  2,  3,  3,  4,
32016     7  3,  2,  2,  2,  2,  2,  4,  3,  3,  3,
32017     8  3,  3,  3,  3,  4,  4,  4,  2,  2,  2,
32018     9  2,  2,  2,  2,  2,  2,  4,  4,  4/
32019C
32020C  PLOTTERS WITH 8 PENS (HP-GL, CALCOMP, ZETA)
32021C
32022C  BLACK   = 1
32023C  RED     = 2
32024C  BLUE    = 3
32025C  GREEN   = 4
32026C  MAGENTA = 5
32027C  ORANGE  = 6
32028C  CYAN    = 7
32029C  YELLOW  = 8
32030C
32031      DATA (JPLOT8(I),I=1,MAXCLR)/
32032     1  1,  1,  2,  3,  4,  5,  6,  7,  8,  8,
32033     2  4,  7,  3,  2,  1,  1,  3,  8,  3,  2,
32034     3  3,  4,  5,  3,  5,  8,  4,  8,  8,  1,
32035     4  2,  8,  1,  3,  4,  5,  7,  3,  4,  8,
32036     5  5,  4,  7,  4,  5,  5,  3,  3,  6,  5,
32037     6  4,  2,  5,  5,  8,  4,  5,  7,  3,  4,
32038     7  3,  8,  8,  5,  5,  8,  4,  7,  3,  3,
32039     8  3,  7,  7,  7,  4,  4,  4,  8,  8,  8,
32040     9  6,  6,  6,  2,  2,  2,  5,  5,  5/
32041C
32042C  HP-2622 AND RELATED TERMINALS
32043C
32044C  BLACK   = 0
32045C  RED     = 1
32046C  GREEN   = 2
32047C  YELLOW  = 3
32048C  BLUE    = 4
32049C  MAGENTA = 5
32050C  CYAN    = 6
32051C  WHITE   = 7
32052C
32053      DATA (J2622(I),I=1,MAXCLR)/
32054     1  7,  0,  1,  4,  2,  5,  3,  6,  3,  3,
32055     2  2,  6,  4,  1,  0,  7,  6,  3,  4,  1,
32056     3  4,  2,  5,  4,  5,  3,  2,  3,  3,  0,
32057     4  1,  3,  7,  6,  2,  5,  6,  4,  2,  3,
32058     5  5,  2,  6,  2,  5,  5,  4,  4,  3,  5,
32059     6  2,  1,  5,  5,  3,  2,  5,  6,  4,  2,
32060     7  4,  3,  3,  5,  5,  3,  2,  6,  4,  4,
32061     8  4,  6,  6,  6,  2,  2,  2,  3,  3,  3,
32062     9  3,  3,  3,  1,  1,  1,  5,  5,  5/
32063C
32064C  DIRECT RGB DEVICES (CGM, POSTSCRIPT)
32065C
32066C  THESE DEVICES ALLOW THE RGB VALUE TO BE SPECIFIED DIRECTLY,
32067C  SO SIMPLY MAP TO SAME INDEX.  GRSECO ROUTINE WILL THEN USE
32068C  A TABLE OF RGB VALUES.
32069C
32070      DATA (JCGM(I),I=1,MAXCLR)/
32071     1  1,  2,  3,  4,  5,  6,  7,  8,  9, 10,
32072     2 11, 12, 13, 14, 15, 16, 17, 18, 19, 20,
32073     3 21, 22, 23, 24, 25, 26, 27, 28, 29, 30,
32074     4 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
32075     5 41, 42, 43, 44, 45, 46, 47, 48, 49, 50,
32076     6 51, 52, 53, 54, 55, 56, 57, 58, 59, 60,
32077     7 61, 62, 63, 64, 65, 66, 67, 68, 69, 70,
32078     8 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,
32079     9 81, 82, 83, 84, 85, 86, 87, 88, 89/
32080C
32081C  SUN
32082C
32083C  RED     = 1
32084C  GREEN   = 2
32085C  BLUE    = 3
32086C  YELLOW  = 4
32087C  BLACK   = 5
32088C  MAGENTA = 6
32089C  WHITE   = 7
32090C  DARK    = 0  (ONLY MAP DARK GRAY TO THIS, OTHERWISE USE BLACK)
32091C
32092      DATA (JSUN(I),I=1,MAXCLR)/
32093     1  7,  5,  1,  3,  2,  6,  4,  3,  4,  4,
32094     2  2,  3,  3,  1,  0,  7,  3,  4,  3,  1,
32095     3  3,  2,  6,  3,  6,  4,  2,  4,  4,  0,
32096     4  1,  4,  7,  3,  2,  6,  3,  3,  2,  4,
32097     5  6,  2,  3,  2,  6,  6,  3,  3,  1,  6,
32098     6  2,  1,  6,  6,  4,  2,  6,  3,  3,  2,
32099     7  3,  4,  4,  6,  6,  4,  2,  3,  3,  3,
32100     8  3,  3,  3,  3,  2,  2,  2,  4,  4,  4,
32101     9  4,  4,  4,  1,  1,  1,  6,  6,  6/
32102C
32103C  X11
32104C
32105C  SUPPORTS FULL SET OF COLORS
32106C
32107      DATA (JX11(I),I=1,MAXCLR)/
32108     1  1,  0,  4,  5,  2,  6,  8,  7,  3,  9,
32109     2 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
32110     3 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
32111     4 30, 31, 32, 33, 34, 35, 36, 37, 38, 39,
32112     5 40, 41, 42, 43, 44, 45, 46, 47, 48, 49,
32113     6 50, 51, 52, 53, 54, 55, 56, 57, 58, 59,
32114     7 60, 61, 62, 63, 64, 65, 66, 67, 68, 69,
32115     8 70, 71, 72, 73, 74, 75, 76, 77, 78, 79,
32116     9 80, 81, 82, 83, 84, 85, 86, 87, 88/
32117C
32118C  REGIS
32119C
32120C  SUPPORTS FULL SET OF COLORS (WITH 1 OR 2 OMISSIONS)
32121C
32122      DATA (JREGIS(I),I=1,MAXCLR)/
32123     1 62,  3, 47,  4, 23, 39, 41, 18, 63, 64,
32124     2 24,  8, 60, 51, 35, 37,  1,  3,  5, 17,
32125     3  6, 25, 43,  7, 57, 19, 26, 20, 21, 35,
32126     4 48, 38, 36,  9, 27, 40,  2, 10, 28, 22,
32127     5 44, 29, 11, 30, 58, 49, 12, 13, 50, 42,
32128     6 31, 45, 46, 57, 52, 32, 53, 14, 15, 33,
32129     7 16, 54, 55, 56, 59, 61, 34, 18,  4,  4,
32130     8  4, 18, 18, 18, 23, 23, 23, 63, 63, 63,
32131     9 41, 41, 41, 47, 47, 47, 39, 39, 39/
32132C
32133C  IBM-PC (TURBO-C DRIVER)
32134C
32135C  BLACK   = 0
32136C  BLUE    = 1
32137C  GREEN   = 2
32138C  CYAN    = 3
32139C  RED     = 4
32140C  MAGENTA = 5
32141C  BROWN   = 6
32142C  GRAY    = 7
32143C  DGRA    = 8
32144C  LBLUE   = 9
32145C  LGRAY   =10
32146C  LCYAN   =11
32147C  LRED    =12
32148C  LMAGE   =13
32149C  YELLOW  =14
32150C  WHITE   =15
32151C
32152C  LRED,  LMAGE ARE NOT IN THE SUPPORTED COLOR LIST.
32153C  LRED MAPS TO RED2
32154C  LMAG MAPS TO MAG2
32155C
32156      DATA (JPC(I),I=1,MAXCLR)/
32157     1 15,  0,  4,  1,  2,  5, 14,  3, 14, 14,
32158     2  2,  9,  1,  4,  8, 10,  3,  6,  9, 12,
32159     3  1,  2,  5,  1,  5, 14,  2, 14, 14,  7,
32160     4 12, 14, 10,  9,  2,  5, 11,  9,  2, 14,
32161     5  5,  2,  9,  2, 13,  5,  1,  1,  4, 13,
32162     6  2,  4,  5,  5, 14,  2,  5, 11,  1,  2,
32163     7  1,  6, 14,  5,  5, 14,  2, 11,  1,  1,
32164     8  1,  3,  3,  3,  2,  2,  2, 14, 14, 14,
32165     9 14, 14, 14,  4,  4,  4,  5,  5,  5/
32166C
32167C  IBM-PC  (LAHEY DRIVER)
32168C
32169C  BLACK   = 0
32170C  BLUE    = 1
32171C  GREEN   = 2
32172C  CYAN    = 3
32173C  RED     = 4
32174C  MAGENTA = 5
32175C  BROWN   = 6
32176C  GRAY    = 7
32177C  DGRA    = 8
32178C  LBLUE   = 9
32179C  LGRAY   =10
32180C  LCYAN   =11
32181C  LRED    =12
32182C  LMAGE   =13
32183C  YELLOW  =14
32184C  WHITE   =15
32185C
32186C  LRED,  LMAGE ARE NOT IN THE SUPPORTED COLOR LIST.
32187C  LRED MAPS TO RED2
32188C  LMAG MAPS TO MAG2
32189C
32190      DATA (JLAHEY(I),I=1,MAXCLR)/
32191     1 15,  0,  4,  1,  2,  5, 14,  3, 14, 14,
32192     2  2,  9,  1,  4,  8, 10,  3,  6,  9, 12,
32193     3  1,  2,  5,  1,  5, 14,  2, 14, 14,  7,
32194     4 12, 14, 10,  9,  2,  5, 11,  9,  2, 14,
32195     5  5,  2,  9,  2, 13,  5,  1,  1,  4, 13,
32196     6  2,  4,  5,  5, 14,  2,  5, 11,  1,  2,
32197     7  1,  6, 14,  5,  5, 14,  2, 11,  1,  1,
32198     8  1,  3,  3,  3,  2,  2,  2, 14, 14, 14,
32199     9 14, 14, 14,  4,  4,  4,  5,  5,  5/
32200C
32201C  IBM-PC  (LAHEY DRIVER, USING INTERACTOR OR WINTERACTOR)
32202C          THIS DRIVER SUPPORTS 16 COLORS, WITH EACH COLOR
32203C          SUPPORTING 16 SHADES.
32204C
32205C  WHITE         = 0 - 15
32206C  LIGHT RED     = 16 - 31
32207C  DARK  RED     = 32 - 47
32208C  LIGHT YELLOW  = 48 - 63
32209C  DARK  YELLOW  = 64 - 79
32210C  LIGHT GREEN   = 80 - 95
32211C  DARK  GREEN   = 96 - 111
32212C  LIGHT CYAN    = 112 - 127
32213C  DARK  CYAN    = 128 - 143
32214C  LIGHT BLUE    = 144 - 159
32215C  DARK  BLUE    = 160 - 175
32216C  LIGHT MAGENTA = 176 - 191
32217C  DARK  MAGENTA = 192 - 207
32218C  BLACK         = 208 - 223
32219C  DARK  GRAY    = 224 - 239
32220C  LIGHT GRAY    = 240 - 255
32221C
32222      DATA (JWINT(I),I=1,MAXCLR)/
32223     1  0,223, 47,175,111,207, 31,143, 79, 80,
32224     2111,144,207, 47,224,240, 80,223,160, 16,
32225     3144,111,207,175, 96, 64, 95, 64, 64, 224,
32226     4 32, 16,240,144, 80,192, 96,159, 96, 48,
32227     5 32, 96,160, 96,192,192,143,128, 32, 32,
32228     6 80, 16,176,207, 31, 95,127,159,160, 95,
32229     7160, 16, 48,176,207, 63, 64,112,164,168,
32230     8172,132,136,140,100,104,108, 68, 72, 76,
32231     9 20, 24, 28, 36, 40, 44,196,200,204/
32232C
32233C-----START POINT-----------------------------------------------------
32234C
32235C  AUGUST 1992.  BE CONSISTENT IN COLORS RECOGNIZED AND IN MAPPING
32236C  INDEX TO COLOR.  EXCEPTION IS THAT PEN PLOTTERS WILL STILL TREAT
32237C  INDEX AS A SLOT NUMBER (SINCE SLOT NUMBERS MAY BE FILLED WITH AN
32238C  ARBITRARY COLOR).
32239C
32240C     *****************************************************************
32241C     **  DATAPLOT SUPPORTS THE FOLLOWING COLORS.  THE TABLE SHOWS   **
32242C     **  THE DATAPLOT 4 CHARACTER NAME AND ASSOCIATED INDEX NUMBER. **
32243C     **  THE SUPPORTED COLORS ARE THE "NAMED" COLORS IN THE COLOR   **
32244C     **  DATABASE IN RELEASE 3 OF X11.  A FEW ADDITIONS ARE ADDED   **
32245C     **  FROM RELEASE 4 OF X11 (BUT NOT THE ENTIRE SET).  THE SOURCE**
32246C     **  IS APPENDIX D OF THE XLIB PROGRAMMERS REFERENCE (VOL. II)  **
32247C     **  FROM O'REILLY AND ASSOCIATES.  EVEN THOUGH WE ARE USING    **
32248C     **  THE RELEASE 3 LIST, USE THE RGB VALUES FROM RELEASE SINCE  **
32249C     **  RELEASE 3 WAS TUNED SPECIFICALLY TO A VT-240 WHILE RELEASE **
32250C     **  4 VALUES SHOULD BE A LITTLE MORE ROBUST.  HOWEVER, THE     **
32251C     **  SAME RGB VALUES CAN PRODUCE DIFFERENT COLORS ON DIFFERENT  **
32252C     **  HARDWARE.                                                  **
32253C     **                                                             **
32254C     **  X11 SUPPORTS THE FULL SET OF COLORS (SOME IMPLEMENTATIONS  **
32255C     **      MAY NOT, UNSUPPORTED COLORS MAPPED TO BLACK/WHITE).    **
32256C     **  POSTSCRIPT ALLOWS RGB VALUES TO BE SPECIFIED DIRECTLY.     **
32257C     **  CGM ALLOWS A COLOR TABLE TO BE DEFINED.                    **
32258C     **  REGIS SUPPORTS 64 OF THE 67 COLORS FROM RELASE 3, NONE OF  **
32259C     **      THE ADDITIONS OF RELEASE 4.                            **
32260C     **  MOST OTHER TERMINALS AND PLOTTERS SUPPORT 4 TO 8 COLORS,   **
32261C     **      UNAVAILABLE COLORS ARE MAPPED TO THE (HOPEFULLY)       **
32262C     **      CLOSEST SUPPORTED COLOR.  PENPLOTTERS ASSUME PEN SLOTS **
32263C     **      CONTAIN THE FOLLOWING COLORS:                          **
32264C     **      4 PENS            8 PENS:                              **
32265C     **      ======            =======                              **
32266C     **      BLACK             BLACK                                **
32267C     **      RED               RED                                  **
32268C     **      BLUE              BLUE                                 **
32269C     **      GREEN             GREEN                                **
32270C     **                        MAGENTA                              **
32271C     **                        ORANGE                               **
32272C     **                        CYAN                                 **
32273C     **                        YELLOW                               **
32274C     **                                                             **
32275C     **   USE THE <HPGL/CALCOMP/ZETA> PEN MAP COMMANDS IF A DIFFERENT*
32276C     **   ORDER IS USED.                                            **
32277C     **                                                             **
32278C     **   THE FOLLOWING IS THE LIST OF CURRENLT RECOGNIZED COLORS.  **
32279C     **                                                             **
32280C     **  COLOR             INDEX     DATAPLOT NAME    RGB           **
32281C     **  =====             =====     =============    ===           **
32282C     **  WHITE               0       WHIT             255, 255, 255 **
32283C     **  BLACK               1       BLAC               0,   0,   0 **
32284C     **  RED                 2       RED              255,   0,   0 **
32285C     **  BLUE                3       BLUE               0,   0, 255 **
32286C     **  GREEN               4       GREE               0, 255,   0 **
32287C     **  MAGENTA             5       MAGE             255,   0, 255 **
32288C     **  ORANGE              6       ORAN             255, 165,   0 **
32289C     **  CYAN                7       CYAN               0, 255, 255 **
32290C     **  YELLOW              8       YELL             255, 255,   0 **
32291C     **  YELLOW GREEN        9       YGRE             154, 205,  50 **
32292C     **  DARK GREEN         10       DGRE               0, 100,   0 **
32293C     **  LIGHT BLUE         11       LBLU             173, 216, 230 **
32294C     **  BLUE VIOLET        12       VBLU             138,  43, 226 **
32295C     **  VIOLET RED         13       VRED             208,  32, 144 **
32296C     **  DARK SLATE GRAY    14       DGRE,DGRA,DGRY    47,  79,  79 **
32297C     **  LIGHT GRAY         15       LGRE,LGRA,LGRY   211, 211, 211 **
32298C     **  AQUAMARINE         16       AQUA             127, 255, 212 **
32299C     **  BROWN              17       BROWN            165,  42,  42 **
32300C     **  CADET BLUE         18       CABL              95, 158, 160 **
32301C     **  CORAL              19       CORA             255, 127,  80 **
32302C     **  CORNFLOWER BLUE    20       CBLU             100, 149, 237 **
32303C     **  DARK OLIVE GREEN   21       DOGR              85, 107,  47 **
32304C     **  DARK ORCHID        22       DORC             153,  50, 204 **
32305C     **  DARK SLATE BLUE    23       DSBL              72,  61, 139 **
32306C     **  DARK TURQUOISE     24       DTUR               0, 206, 209 **
32307C     **  FIREBRICK          25       FIRE             178,  34,  34 **
32308C     **  FOREST GREEN       26       FGRE              34, 139,  34 **
32309C     **  GOLD               27       GOLD             255, 215,   0 **
32310C     **  GOLDENROD          28       GLDR             218, 165,  32 **
32311C     **  GRAY               29       GRAY, GREY       192, 192, 192 **
32312C     **  INDIAN RED         30       IRED, LRED       205,  92,  92 **
32313C     **  KHAKI              31       KHAK             240, 230, 140 **
32314C     **  DIM GRAY           32       DMGR             105, 105, 105 **
32315C     **  LIGHT STEEL BLUE   33       LSBL             176, 196, 222 **
32316C     **  LIME GREEN         34       LGRE              50, 205,  50 **
32317C     **  MAROON             35       MARO             176,  48,  96 **
32318C     **  MEDIUM AQUAMARINE  36       MAQU             102, 205, 170 **
32319C     **  MEDIUM BLUE        37       MBLU               0,   0, 205 **
32320C     **  MEDIUM FOREST GREEN38       MFGR             107, 142,  35 **
32321C     **  LIGHT GOLDENROD YEL39       MGLD             250, 250, 210 **
32322C     **  MEDIUM ORCHID      40       MORC             186,  85, 211 **
32323C     **  MEDIUM SEA GREEN   41       MSGR              60, 179, 113 **
32324C     **  MEDIUM SLATE BLUE  42       MSBL             123, 104, 238 **
32325C     **  MEDIUM SPRING GREEN43       MSPG               0, 250, 154 **
32326C     **  MEDIUM TURQUOISE   44       MTUR, LMAG        72, 209, 204 **
32327C     **  MEDIUM VIOLET RED  45       MVRD             199,  21, 133 **
32328C     **  MIDNIGHT BLUE      46       MDBL              25,  25, 112 **
32329C     **  NAVY BLUE          47       NAVY               0,   0, 128 **
32330C     **  ORANGE RED         48       ORED             255,  69,   0 **
32331C     **  ORCHID             49       ORCH             218, 112, 214 **
32332C     **  PALE GREEN         50       PGRE             152, 251, 152 **
32333C     **  PINK               51       PINK             255, 192, 203 **
32334C     **  PLUM               52       PLUM             221, 160, 221 **
32335C     **  PURPLE             53       PURP             160,  32, 240 **
32336C     **  SALMON             54       SALM             250, 128, 114 **
32337C     **  SEA GREEN          55       SGRE              46, 139,  87 **
32338C     **  SIENNA             56       SIEN             160,  82,  45 **
32339C     **  SKY BLUE           57       SKBL, SKYB,      135, 206, 235 **
32340C     **  SLATE BLUE         58       SBLU             106,  90, 205 **
32341C     **  SPRING GREEN       59       SPGR               0, 255, 127 **
32342C     **  STEEL BLUE         60       STBL              70, 130, 180 **
32343C     **  TAN                61       TAN              210, 180, 140 **
32344C     **  THISTLE            62       THIS             216, 191, 216 **
32345C     **  TURQUOISE          63       TURQ              64, 224, 208 **
32346C     **  VIOLET             64       VIOL             238, 130, 238 **
32347C     **  WHEAT              65       WHEA             245, 222, 179 **
32348C     **  GREEN YELLOW       66       GYEL             173, 255,  47 **
32349C     **  LIGHT CYAN         67       LCYA             224, 255, 255 **
32350C     **  BLUE2              68       BLU2               0,   0, 238 **
32351C     **  BLUE3              69       BLU3               0,   0, 205 **
32352C     **  BLUE4              70       BLU4               0,   0, 139 **
32353C     **  CYAN2              71       CYA2               0, 238, 238 **
32354C     **  CYAN3              72       CYA3               0, 205, 205 **
32355C     **  CYAN4              73       CYA4               0, 139, 139 **
32356C     **  GREEN2             74       GRE2               0, 238,   0 **
32357C     **  GREEN3             75       GRE3               0, 205,   0 **
32358C     **  GREEN4             76       GRE4               0, 139,   0 **
32359C     **  YELLOW2            77       YEL2             238, 238,   0 **
32360C     **  YELLOW3            78       YEL3             205, 205,   0 **
32361C     **  YELLOW4            79       YEL4             139, 139,   0 **
32362C     **  ORANGE2            80       ORA2             238, 154,   0 **
32363C     **  ORANGE3            81       ORA3             205, 133,   0 **
32364C     **  ORANGE4            82       ORA4             139,  90,   0 **
32365C     **  RED2               83       RED2, LRED       238,   0,   0 **
32366C     **  RED3               84       RED3             205,   0,   0 **
32367C     **  RED2               85       RED4             139,   0,   0 **
32368C     **  MAGENTA2           86       MAG2, LMAG       238,   0, 238 **
32369C     **  MAGENTA3           87       MAG3             205,   0, 205 **
32370C     **  MAGENTA4           88       MAG4             139,   0, 139 **
32371C     **                                                             **
32372C     **  SUPPORT GRAY SCALE WITH FOLLOWING SCHEME:                  **
32373C     **  G0     = BLACK                                             **
32374C     **  G1-G99 = GRAY SCALE FROM BLACK TO WHITE                    **
32375C     **  G100   = WHITE                                             **
32376C     **  -1 THROUGH -100 WILL CORRESPOND TO G1 THROUGH G100         **
32377C     **  CURRENTLY, POSTSCRIPT, X11, AND CGM SUPPORT GRAY SCALE,    **
32378C     **  OTHER DEVICES WILL MAP TO BLACK OR WHITE                   **
32379C     **  R0-R255 = LEVELS OF RED FOR DEVICES THAT SUPPORT RGB       **
32380C     **  Z0-Z255 = LEVELS OF GREEN FOR DEVICES THAT SUPPORT RGB     **
32381C     **  B0-B255 = LEVELS OF BLUE FOR DEVICES THAT SUPPORT RGB      **
32382C     *****************************************************************
32383C
32384C     **********************************************
32385C     **    MAP A COLOR NAME TO AN INDEX FOR THE  **
32386C     **    GENERIC CASE.                         **
32387C     **********************************************
32388C
32389      JINDEX=-999
32390C
32391C  CHECK FOR SUPPORTED NAMES
32392C
32393      DO40I=1,MAXCLR
32394        IF(ICOL.EQ.ICOLNM(I))THEN
32395          JINDEX=I-1
32396          GOTO49
32397        ENDIF
32398 40   CONTINUE
32399C
32400C  CHECK FOR SYNONYMS
32401C
32402      IF(ICOL.EQ.'DGRY' .OR. ICOL.EQ.'DGRE')THEN
32403        JINDEX=14
32404        ICOL='DGRE'
32405      ELSEIF(ICOL.EQ.'LGRY' .OR. ICOL.EQ.'LGRE')THEN
32406        JINDEX=15
32407        ICOL='LGRA'
32408      ELSEIF(ICOL.EQ.'GREY')THEN
32409        JINDEX=29
32410        ICOL='GRAY'
32411      ELSEIF(ICOL.EQ.'LRED')THEN
32412        JINDEX=83
32413        ICOL='IRED'
32414      ELSEIF(ICOL.EQ.'LMAG')THEN
32415        JINDEX=44
32416        ICOL='MTUR'
32417      ELSEIF(ICOL.EQ.'SKYB')THEN
32418        JINDEX=57
32419        ICOL='SKBL'
32420      ENDIF
32421 49   CONTINUE
32422C
32423C  CHECK FOR INDEX (0 THROUGH MAXCLR-1)
32424C
32425      CJUNK='    '
32426      DO1I=0,9
32427        WRITE(CJUNK(1:1),'(I1)')I
32428        IF(ICOL(1:4).EQ.CJUNK(1:4))THEN
32429          JINDEX=I
32430          GOTO9
32431        ENDIF
32432 1    CONTINUE
32433 9    CONTINUE
32434      CJUNK='    '
32435      DO11I=10,MAXCLR-1
32436        WRITE(CJUNK(1:2),'(I2)')I
32437        IF(ICOL(1:4).EQ.CJUNK(1:4))THEN
32438          JINDEX=I
32439          GOTO19
32440        ENDIF
32441 11   CONTINUE
32442 19   CONTINUE
32443C
32444C  CHECK FOR GREY SCALE (G0 - G100 OR -1 THROUGH -100)
32445C
32446      IF(ICOL.EQ.'G0')THEN
32447        JINDEX=1
32448        GOTO89
32449      ELSEIF(ICOL.EQ.'G100' .OR. ICOL.EQ.'-100')THEN
32450        JINDEX=0
32451        GOTO89
32452      ELSEIF(ICOL(1:1).EQ.'G'.OR.ICOL(1:1).EQ.'-')THEN
32453        CJUNK='    '
32454        DO21I=1,9
32455          WRITE(CJUNK(1:1),'(I1)')I
32456          IF(ICOL(2:4).EQ.CJUNK(1:3))THEN
32457            JINDEX=-I
32458            GOTO89
32459          ENDIF
32460 21     CONTINUE
32461C
32462        CJUNK='    '
32463        DO31I=10,99
32464          WRITE(CJUNK(1:2),'(I2)')I
32465          IF(ICOL(2:4).EQ.CJUNK(1:3))THEN
32466            JINDEX=-I
32467            GOTO89
32468           ENDIF
32469 31     CONTINUE
32470      ENDIF
32471C
32472C  CHECK FOR RED SCALE (R0 - R255)
32473C
32474C  THESE WILL BE MAPPED TO 1000 - 1255
32475C
32476      IF(ICOL(1:1).EQ.'R')THEN
32477        DO41I=0,9
32478          CJUNK='    '
32479          WRITE(CJUNK(1:1),'(I1)')I
32480          IF(ICOL(2:4).EQ.CJUNK(1:3))THEN
32481            JCOL=1000 + I
32482            GOTO9000
32483          ENDIF
32484 41     CONTINUE
32485C
32486        DO43I=10,99
32487          CJUNK='    '
32488          WRITE(CJUNK(1:2),'(I2)')I
32489          IF(ICOL(2:4).EQ.CJUNK(1:3))THEN
32490            JCOL=1000 + I
32491            GOTO9000
32492          ENDIF
32493 43     CONTINUE
32494C
32495        DO45I=100,255
32496          CJUNK='    '
32497          WRITE(CJUNK(1:3),'(I3)')I
32498          IF(ICOL(2:4).EQ.CJUNK(1:3))THEN
32499            JCOL=1000 + I
32500            GOTO9000
32501          ENDIF
32502 45     CONTINUE
32503      ENDIF
32504C
32505C  CHECK FOR GREEN SCALE (Z0 - Z255)
32506C
32507C  THESE WILL BE MAPPED TO 2000 - 2255
32508C
32509      IF(ICOL(1:1).EQ.'Z')THEN
32510        DO51I=0,9
32511          CJUNK='    '
32512          WRITE(CJUNK(1:1),'(I1)')I
32513          IF(ICOL(2:4).EQ.CJUNK(1:3))THEN
32514            JCOL=2000 + I
32515            GOTO9000
32516          ENDIF
32517 51     CONTINUE
32518C
32519        DO53I=10,99
32520          CJUNK='    '
32521          WRITE(CJUNK(1:2),'(I2)')I
32522          IF(ICOL(2:4).EQ.CJUNK(1:3))THEN
32523            JCOL=2000 + I
32524            GOTO9000
32525          ENDIF
32526 53     CONTINUE
32527C
32528        DO55I=100,255
32529          CJUNK='    '
32530          WRITE(CJUNK(1:3),'(I3)')I
32531          IF(ICOL(2:4).EQ.CJUNK(1:3))THEN
32532            JCOL=2000 + I
32533            GOTO9000
32534          ENDIF
32535 55     CONTINUE
32536      ENDIF
32537C
32538C  CHECK FOR BLUE SCALE (B0 - B255)
32539C
32540C  THESE WILL BE MAPPED TO 3000 - 3255
32541C
32542      IF(ICOL(1:1).EQ.'B')THEN
32543        DO61I=0,9
32544          CJUNK='    '
32545          WRITE(CJUNK(1:1),'(I1)')I
32546          IF(ICOL(2:4).EQ.CJUNK(1:3))THEN
32547            JCOL=3000 + I
32548            GOTO9000
32549          ENDIF
32550 61     CONTINUE
32551C
32552        DO63I=10,99
32553          CJUNK='    '
32554          WRITE(CJUNK(1:2),'(I2)')I
32555          IF(ICOL(2:4).EQ.CJUNK(1:3))THEN
32556            JCOL=3000 + I
32557            GOTO9000
32558          ENDIF
32559 63     CONTINUE
32560C
32561        DO65I=100,255
32562          CJUNK='    '
32563          WRITE(CJUNK(1:3),'(I3)')I
32564          IF(ICOL(2:4).EQ.CJUNK(1:3))THEN
32565            JCOL=3000 + I
32566            GOTO9000
32567          ENDIF
32568 65     CONTINUE
32569      ENDIF
32570C
32571   89 CONTINUE
32572C
32573      ISUBN0='TRCO'
32574      IERRG4='NO'
32575C
32576      NCSTR=(-999)
32577C
32578      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRCO')THEN
32579        WRITE(ICOUT,999)
32580  999   FORMAT(1X)
32581        CALL DPWRST('XXX','BUG ')
32582        WRITE(ICOUT,91)
32583   91   FORMAT('***** AT THE BEGINNING OF GRTRCO--')
32584        CALL DPWRST('XXX','BUG ')
32585        WRITE(ICOUT,92)IMANUF,IMODEL,IMODE2,IMODE3
32586   92   FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',3(A4,2X),A4)
32587        CALL DPWRST('XXX','BUG ')
32588        WRITE(ICOUT,93)ISOFT,ISOFT2,ISOFT3,IGCODE,IGUNIT
32589   93   FORMAT('ISOFT,ISOFT2,ISOFT3,IGCODE = ',5(A4,2X),I8)
32590        CALL DPWRST('XXX','BUG ')
32591        WRITE(ICOUT,94)ICASE,ICOL,IBUGG4
32592   94   FORMAT('ICASE,ICOL,IBUGG4 = ',2(A4,2X),A4)
32593        CALL DPWRST('XXX','BUG ')
32594      ENDIF
32595C
32596C               ********************************************
32597C               **  STEP 1--                              **
32598C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
32599C               **  AND THE MODEL                         **
32600C               ********************************************
32601C
32602      IF(IMANUF.EQ.'QWIN')THEN
32603        GOTO4700
32604      ELSEIF(IMANUF.EQ.'POST')THEN
32605        GOTO8600
32606      ELSEIF(IMANUF.EQ.'X11 ')THEN
32607        GOTO9600
32608      ELSEIF(IMANUF.EQ.'AQUA')THEN
32609        GOTO13500
32610      ELSEIF(IMANUF.EQ.'GENE')THEN
32611        IF(IMODEL.EQ.'CODE')GOTO3200
32612        IF(IMODEL.EQ.'CGM')GOTO3300
32613        IF(IMODEL.EQ.'CGMB')GOTO3400
32614        GOTO3100
32615      ELSEIF(IMANUF.EQ.'SVG ')THEN
32616        GOTO16000
32617      ELSEIF(IMANUF.EQ.'GD  ')THEN
32618        GOTO12000
32619      ELSEIF(IMANUF.EQ.'LATE')THEN
32620        GOTO15000
32621      ELSEIF(IMANUF.EQ.'CAIR')THEN
32622        GOTO17000
32623      ELSEIF(IMANUF.EQ.'D3  ')THEN
32624        GOTO19000
32625      ELSEIF(IMANUF.EQ.'WMF ')THEN
32626        GOTO18000
32627      ELSEIF(IMANUF.EQ.'OPGL')THEN
32628        GOTO4800
32629      ELSEIF(IMANUF.EQ.'TEKT')THEN
32630        IF(IMODEL.EQ.'4027')GOTO1100
32631        IF(IMODEL.EQ.'4105')GOTO1200
32632        IF(IMODEL.EQ.'4107')GOTO1200
32633        IF(IMODEL.EQ.'4109')GOTO1200
32634        IF(IMODEL.EQ.'4115')GOTO1200
32635        IF(IMODEL.EQ.'4662')GOTO1300
32636C
32637        GOTO1200
32638      ELSEIF(IMANUF.EQ.'HP')THEN
32639        IF(IMODEL.EQ.'7221')GOTO2100
32640        IF(IMODEL.EQ.'2622')GOTO2300
32641        IF(IMODEL.EQ.'2623')GOTO2300
32642        IF(IMODEL.EQ.'2627')GOTO2300
32643        IF(IMODEL.EQ.'2647')GOTO2300
32644        GOTO2200
32645      ELSEIF(IMANUF.EQ.'LIBP')THEN
32646        GOTO2600
32647      ELSEIF(IMANUF.EQ.'REGI')THEN
32648        GOTO8100
32649      ELSEIF(IMANUF.EQ.'GKS ')THEN
32650        GOTO11000
32651      ELSEIF(IMANUF.EQ.'LAHE')THEN
32652        IF(IMODEL.EQ.'INTE')GOTO4900
32653        IF(IMODEL.EQ.'WINT')GOTO4950
32654        GOTO4600
32655      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
32656        GOTO13000
32657      ELSEIF(IMANUF.EQ.'QUIC')THEN
32658        GOTO9100
32659      ELSEIF(IMANUF.EQ.'CALC')THEN
32660        GOTO4100
32661      ELSEIF(IMANUF.EQ.'ZETA')THEN
32662        GOTO5100
32663      ELSEIF(IMANUF.EQ.'TURB')THEN
32664        GOTO10000
32665      ELSEIF(IMANUF.EQ.'SUN ')THEN
32666        GOTO6600
32667      ENDIF
32668      GOTO9000
32669C
32670C               ******************************************************
32671C               **  STEP 11--                                       **
32672C               **  TREAT THE 4027 CASE                             **
32673C               **  (COLOR DEVICE)                                  **
32674C               **  REFERENCE--XXX                                  **
32675C               ******************************************************
32676C
32677 1100 CONTINUE
32678      JCOL=0
32679      IF(JINDEX.LT.0)JCOL=0
32680      IF(JINDEX.GE.0)JCOL=J4027(JINDEX+1)
32681      GOTO9000
32682C
32683C               ******************************************************
32684C               **  STEP 12--                                       **
32685C               **  TREAT THE 4105 CASE                             **
32686C               **  (COLOR DEVICE)                                  **
32687C               **  REFERENCE--PROGRAMMER'S MANUAL, PAGE 5-50       **
32688C               ******************************************************
32689C
32690 1200 CONTINUE
32691      JCOL=0
32692      IF(JINDEX.LT.0)JCOL=0
32693      IF(JINDEX.GE.0)JCOL=J4105(JINDEX+1)
32694      GOTO9000
32695C
32696C               ******************************************************
32697C               **  STEP 13--                                       **
32698C               **  TREAT THE 4662 CASE                             **
32699C               **  (PENPLOTTER)                                    **
32700C               **  REFERENCE--XXX                                  **
32701C               ******************************************************
32702C
32703 1300 CONTINUE
32704      JCOL=1
32705      IF(JINDEX.LT.0)JCOL=1
32706      IF(JINDEX.GE.0)JCOL=JPLOT4(JINDEX+1)
32707      GOTO9000
32708C
32709C               ******************************************************
32710C               **  STEP 21--                                       **
32711C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
32712C               **  (MULTI-COLOR PENPLOTTER)                        **
32713C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
32714C               **             OPERATING AND PROGRAMMING MANUAL,    **
32715C               **             PAGE 6 .                             **
32716C               ******************************************************
32717C
32718 2100 CONTINUE
32719      JCOL=1
32720      IF(JINDEX.LT.0)JCOL=1
32721      IF(JINDEX.GE.0)JCOL=JPLOT8(JINDEX+1)
32722      GOTO9000
32723C
32724C               ******************************************************
32725C               **  STEP 22--                                       **
32726C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
32727C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
32728C               **  (MULTI-COLOR PENPLOTTERS)                       **
32729C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
32730C               **             OPERATING AND PROGRAMMING MANUAL,    **
32731C               **             PAGE XX, XXX.                        **
32732C               ******************************************************
32733C
32734C  UPDATED MAY, 1990 FOR "PEN MAP"
32735C
32736 2200 CONTINUE
32737C
32738      IF(IHPGPF.EQ.'ON')THEN
32739        JCOL=1
32740        DO2219I=1,16
32741          IF(ICOL(1:4).NE.IHPGPM(I)(1:4))GOTO2219
32742          JCOL=I
32743          GOTO2299
32744 2219   CONTINUE
32745C
32746        IF(ICOL.EQ.'0')JCOL=0
32747        IF(ICOL.EQ.'1')JCOL=1
32748        IF(ICOL.EQ.'2')JCOL=2
32749        IF(ICOL.EQ.'3')JCOL=3
32750        IF(ICOL.EQ.'4')JCOL=4
32751        IF(ICOL.EQ.'5')JCOL=5
32752        IF(ICOL.EQ.'6')JCOL=6
32753        IF(ICOL.EQ.'7')JCOL=7
32754        IF(ICOL.EQ.'8')JCOL=8
32755C
32756 2299   CONTINUE
32757        IF(JCOL.GT.IHPGCL)JCOL=1
32758      ELSE
32759        JCOL=1
32760        IF(JINDEX.LT.0)JCOL=1
32761        IF(JINDEX.GE.0)JCOL=JPLOT8(JINDEX+1)
32762        IF(JCOL.GT.IHPGCL)JCOL=MOD(JCOL-1,IHPGCL)+1
32763      ENDIF
32764      GOTO9000
32765C
32766C               **********************************************************
32767C               **  STEP 23--                                           **
32768C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
32769C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
32770C               **  (MONOCHROME DISPLAY TERMINALS)                      **
32771C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
32772C               **             REFERENCE MANUAL,                        **
32773C               **             PAGE XX-X, XXX.                          **
32774C               **********************************************************
32775C
32776 2300 CONTINUE
32777      JCOL=7
32778      IF(JINDEX.LT.0)JCOL=7
32779      IF(JINDEX.GE.0)JCOL=J2622(JINDEX+1)
32780      GOTO9000
32781C
32782C               ******************************************************
32783C               **  STEP 26--                                       **
32784C               **  TREAT THE UNIX LIBPLOT CASE.                    **
32785C               **  USE RGB COLORS.                                 **
32786C               ******************************************************
32787C
32788 2600 CONTINUE
32789      JCOL=2
32790      IF(JINDEX.LT.0)JCOL=JINDEX
32791      IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
32792      GOTO9000
32793C
32794C               ******************************************************
32795C               **  STEP 31--                                       **
32796C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
32797C               ******************************************************
32798C
32799 3100 CONTINUE
32800C  DECEMBER 1987: SET JCOL FOR GRERSC ROUTINE
32801      JCOL=0
32802      IF(JINDEX.LT.0)JCOL=0
32803      IF(JINDEX.GE.0)JCOL=J4105(JINDEX+1)
32804      GOTO9000
32805C
32806C               ***************************************************************
32807C               **  STEP 32--                                                **
32808C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
32809C               ***************************************************************
32810C
32811 3200 CONTINUE
32812C  DECEMBER 1987: SET JCOL FOR GRERSC ROUTINE
32813      JCOL=0
32814      IF(JINDEX.LT.0)JCOL=0
32815      IF(JINDEX.GE.0)JCOL=J4105(JINDEX+1)
32816      GOTO9000
32817C
32818C               ******************************************************
32819C               **  STEP 33--                                       **
32820C               **  TREAT THE CGM     (DEVICE-INDEPENDENT) CASE     **
32821C               **  NOTE: INDEX 0 IS RESERVED FOR THE BACKGROUND    **
32822C               **        COLOR.                                    **
32823C               **  NOTE: CGM ALSO ALLOWS COLORS TO BE SPECIFED BY  **
32824C               **        RGB COMPONENT RATHER THAN BY AN INDEX.  A **
32825C               **        FUTURE ENHANCEMENT WOULD BE TO SPECIFY    **
32826C               **        COLORS IN THIS FORMAT (SO BLUE WOULD BE   **
32827C               **        AN ACTUAL BLUE RATHER THAN AN ARBITRARY   **
32828C               **        INDEX NUMBER).                            **
32829C               **  AUGUST 1992.  USE RGB VALUES                    **
32830C               ******************************************************
32831C
32832 3300 CONTINUE
32833      JCOL=2
32834      IF(JINDEX.LT.0)JCOL=2
32835      IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
32836      GOTO9000
32837C
32838C               ***************************************************
32839C               **  STEP 34--                                    **
32840C               **  TREAT THE CGM (BINARY)                 CASE  **
32841C               ***************************************************
32842C
32843 3400 CONTINUE
32844      GOTO9000
32845C
32846C               ******************************************************
32847C               **  STEP 41--                                       **
32848C               **  TREAT THE CALCOMP XXXXXX CASE                   **
32849C               **  USE CALCOMP LIBRARY (ROUTINE NEWPEN SELECTS PEN)**
32850C               **  REFERENCE--XX                                   **
32851C               **             XX                                   **
32852C               **             PAGES XX AND XX                      **
32853C               ******************************************************
32854C
32855 4100 CONTINUE
32856C
32857C     UPDATE MAY, 1990.
32858C     1) CHANGE DEFAULT ORDER FROM BLACK, RED, BLUE, GREEN TO BLACK,
32859C        RED, GREEN, BLUE (TO CORRESPOND TO DEFAULT ORDER IN NIST ZETA
32860C        LIBRARY)
32861C     2) DIFFERENT DEFAULT MAPPING BASED ON WHETHER 4 (OR LESS) OR MORE
32862C        THAN 4
32863C     3) CHECK FOR USER DEFINED PEN MAPPING
32864C
32865      IF(ICALPF.EQ.'ON')THEN
32866        JCOL=1
32867        DO4139I=1,16
32868          IF(ICOL(1:4).NE.ICALPM(I)(1:4))GOTO4139
32869          JCOL=I
32870          GOTO4199
32871 4139   CONTINUE
32872C
32873        IF(ICOL.EQ.'0')JCOL=0
32874        IF(ICOL.EQ.'1')JCOL=1
32875        IF(ICOL.EQ.'2')JCOL=2
32876        IF(ICOL.EQ.'3')JCOL=3
32877        IF(ICOL.EQ.'4')JCOL=4
32878        IF(ICOL.EQ.'5')JCOL=5
32879        IF(ICOL.EQ.'6')JCOL=6
32880        IF(ICOL.EQ.'7')JCOL=7
32881        IF(ICOL.EQ.'8')JCOL=8
32882      ELSE
32883        JCOL=1
32884        IF(JINDEX.LT.0)JCOL=1
32885        IF(JINDEX.GE.0)JCOL=JPLOT8(JINDEX+1)
32886        IF(JCOL.GT.ICALCL)JCOL=MOD(JCOL-1,ICALCL)+1
32887      ENDIF
32888C
32889 4199 CONTINUE
32890      IF(JCOL.GT.ICALCL)JCOL=1
32891      GOTO9000
32892C
32893C               ******************************************************
32894C               **  STEP 46--                                       **
32895C               **  TREAT THE LAHEY   XXXXXX CASE                   **
32896C               **  REFERENCE--Programmer's Reference, Revision C   **
32897C               **             Lahey Computer Systems, January, 1992**
32898C               **             PAGES 51 THRU 65                     **
32899C               ******************************************************
32900C
32901 4600 CONTINUE
32902      IF(ILAHPF.EQ.'ON')THEN
32903        JCOL=1
32904        DO4639I=1,16
32905          IF(ICOL(1:4).NE.ILAHPM(I)(1:4))GOTO4639
32906          JCOL=I
32907          GOTO4699
32908 4639   CONTINUE
32909C
32910        IF(ICOL.EQ.'0')JCOL=0
32911        IF(ICOL.EQ.'1')JCOL=1
32912        IF(ICOL.EQ.'2')JCOL=2
32913        IF(ICOL.EQ.'3')JCOL=3
32914        IF(ICOL.EQ.'4')JCOL=4
32915        IF(ICOL.EQ.'5')JCOL=5
32916        IF(ICOL.EQ.'6')JCOL=6
32917        IF(ICOL.EQ.'7')JCOL=7
32918        IF(ICOL.EQ.'8')JCOL=8
32919      ELSE
32920        JCOL=1
32921        IF(JINDEX.LT.0)JCOL=1
32922        IF(JINDEX.GE.0)JCOL=JLAHEY(JINDEX+1)
32923        IF(JCOL.GT.ILAHNC)JCOL=MOD(JCOL-1,ILAHNC)+1
32924      ENDIF
32925C
32926 4699 CONTINUE
32927      IF(JCOL.GT.ILAHNC)JCOL=1
32928      GOTO9000
32929C
32930C               ******************************************************
32931C               **  STEP 47--                                       **
32932C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
32933C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
32934C               ******************************************************
32935C
32936 4700 CONTINUE
32937      IF(IQWNCL.EQ.'VGA')THEN
32938        JCOL=0
32939        IF(JINDEX.LT.0)JCOL=0
32940        IF(JINDEX.GE.0)JCOL=JPC(JINDEX+1)
32941      ELSEIF(IQWNCL.EQ.'RGB')THEN
32942        JCOL=1
32943        IF(JINDEX.LT.0)JCOL=JINDEX
32944        IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
32945      ELSE
32946        JCOL=0
32947        IF(JINDEX.LT.0)JCOL=0
32948        IF(JINDEX.GE.0)JCOL=JPC(JINDEX+1)
32949      ENDIF
32950      GOTO9000
32951C
32952C               ******************************************************
32953C               **  STEP 48--                                       **
32954C               **  TREAT THE OPEN-GL DRIVER                        **
32955C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
32956C               ******************************************************
32957C
32958 4800 CONTINUE
32959      JCOL=0
32960      IF(JINDEX.LT.0)JCOL=JINDEX
32961      IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
32962      GOTO9000
32963C
32964C               ******************************************************
32965C               **  STEP 49--                                       **
32966C               **  TREAT THE LAHEY INTERACTOR CASE                 **
32967C               ******************************************************
32968C
32969 4900 CONTINUE
32970      JCOL=223
32971      IF(JINDEX.LT.0)THEN
32972        JCOL=224 + INT((REAL(-JINDEX)/100.)*31. + 0.5)
32973        IF(JCOL.LT.224)JCOL=224
32974        IF(JCOL.GT.255)JCOL=255
32975      ENDIF
32976      IF(JINDEX.GE.0)JCOL=JWINT(JINDEX+1)
32977      GOTO9000
32978C
32979C               ******************************************************
32980C               **  STEP 49B-                                       **
32981C               **  TREAT THE LAHEY WINTERACTOR CASE                **
32982C               ******************************************************
32983C
32984 4950 CONTINUE
32985      IF(IWINCL.EQ.'VGA')THEN
32986        JCOL=223
32987        IF(JINDEX.LT.0)THEN
32988          JCOL=224 + INT((REAL(-JINDEX)/100.)*31. + 0.5)
32989          IF(JCOL.LT.224)JCOL=224
32990          IF(JCOL.GT.255)JCOL=255
32991        ELSE
32992          JCOL=JWINT(JINDEX)
32993        ENDIF
32994      ELSEIF(IWINCL.EQ.'RGB')THEN
32995        JCOL=2
32996        IF(JINDEX.LT.0)JCOL=JINDEX
32997        IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
32998      ELSE
32999        JCOL=223
33000        IF(JINDEX.LT.0)THEN
33001          JCOL=224 + INT((REAL(-JINDEX)/100.)*31. + 0.5)
33002          IF(JCOL.LT.224)JCOL=224
33003          IF(JCOL.GT.255)JCOL=255
33004        ELSE
33005          JCOL=JWINT(JINDEX)
33006        ENDIF
33007      ENDIF
33008      GOTO9000
33009C
33010C
33011C               ******************************************************
33012C               **  STEP 51--                                       **
33013C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
33014C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
33015C               **             MODELS 3600SX AND 3653SX             **
33016C               **             PAGES B-0 AND B-1                    **
33017C               **  USE CALCOMP LIBRARY ROUTINES                    **
33018C               ******************************************************
33019C
33020C     UPDATE MAY, 1990.
33021C     1) CHANGE DEFAULT ORDER FROM BLACK, RED, BLUE, GREEN TO BLACK, RED,
33022C        GREEN, BLUE (TO CORRESPOND TO DEFAULT ORDER IN NIST ZETA
33023C        LIBRARY)
33024C     2) DIFFERENT DEFAULT MAPPING BASED ON WHETHER 4 (OR LESS) OR MORE
33025C        THAN 4
33026C     3) CHECK FOR USER DEFINED PEN MAPPING
33027C
33028 5100 CONTINUE
33029C
33030      IF(IZETPF.EQ.'ON')THEN
33031        JCOL=1
33032        DO5139I=1,16
33033          IF(ICOL(1:4).NE.IZETPM(I)(1:4))GOTO5139
33034          JCOL=I
33035          GOTO5199
33036 5139   CONTINUE
33037C
33038        IF(ICOL.EQ.'0')JCOL=0
33039        IF(ICOL.EQ.'1')JCOL=1
33040        IF(ICOL.EQ.'2')JCOL=2
33041        IF(ICOL.EQ.'3')JCOL=3
33042        IF(ICOL.EQ.'4')JCOL=4
33043        IF(ICOL.EQ.'5')JCOL=5
33044        IF(ICOL.EQ.'6')JCOL=6
33045        IF(ICOL.EQ.'7')JCOL=7
33046        IF(ICOL.EQ.'8')JCOL=8
33047      ELSE
33048        JCOL=1
33049        IF(JINDEX.LT.0)JCOL=1
33050        IF(JINDEX.GE.0)JCOL=JPLOT8(JINDEX+1)
33051        IF(JCOL.GT.IZETCL)JCOL=MOD(JCOL-1,IZETCL)+1
33052      ENDIF
33053C
33054 5199 CONTINUE
33055      IF(JCOL.GT.IZETCL)JCOL=1
33056      GOTO9000
33057C
33058C               ******************************************************
33059C               **  STEP 66--                                       **
33060C               **  TREAT THE SUN CASE - COLOR SUPPORTED            **
33061C               ******************************************************
33062C
33063 6600 CONTINUE
33064      IF(ISUNCL.LE.0) THEN
33065        JCOL=1
33066      ELSE
33067        JCOL=5
33068        IF(JINDEX.LT.0)JCOL=5
33069        IF(JINDEX.GE.0)JCOL=JSUN(JINDEX+1)
33070      ENDIF
33071      GOTO9000
33072C
33073C               ******************************************************
33074C               **  STEP 81--                                       **
33075C               **  TREAT THE REGIS CASE                            **
33076C               **  NON-COLOR DEVICE                                **
33077C               **  ADD COLOR SUPPORT FOR REGIS JANUARY, 1991.      **
33078C               **  NOTE THAT REGIS SUPPORTS COLOR IN TWO WAYS.     **
33079C               **  IT ALLOWS AN RGB COLOR SPECIFIED BY NAME.  THIS **
33080C               **  METHOD ALLOWS 8 DIFFERENT COLORS (BLACK, RED,   **
33081C               **  GREEN, BLUE, CYAN, YELLOW, MAGENTA, WHITE)  IT  **
33082C               **  ALSO ALLOWS COLORS TO BE SPECIFIED BY HUE,      **
33083C               **  LIGHTNESS, AND SATURATION VALUES.  THIS METHOD  **
33084C               **  ALLOWS 64 COLORS TO BE SPECIFIED.  WE WILL USE  **
33085C               **  THE HLS METHOD SINCE IT ALLOWS MORE COLOR (ALL  **
33086C               **  THE RGB COLORS HAVE A CORRESPONDING HLS SPEC).  **
33087C               **  UNFORTUNATELY, NOT ALL THE COLORS HAVE SIMPLE 4 **
33088C               **  CHARACTER CODES.  MOST COLORS WILL HAVE TO BE   **
33089C               **  SPECIFIED BY AN INDEX.  TO MAKE IT EASIER FOR   **
33090C               **  USERS, A "SHOW REGIS COLORS" COMMAND WAS ADDED. **
33091C               **  TRANSLATION TAKEN FROM 5-32 OF VT-240 MANUAL.   **
33092C               **  NOTE THAT MONOCHROME REGIS SUPPORTS 4 INTENSITY **
33093C               **  LEVELS (I.E., GREY SCALES).  WE HAVE NOT        **
33094C               **  IMPLEMENTED GREY-SCALE REGION FILLS AS IS DONE  **
33095C               **  WITH MONOCHROME POSTSCRIPT DEVICES.             **
33096C               ******************************************************
33097C
33098 8100 CONTINUE
33099      JCOL=3
33100      IF(IGCOLO.NE.'ON')GOTO9000
33101C
33102      IF(JINDEX.LT.0)JCOL=3
33103      IF(JINDEX.GE.0)JCOL=JREGIS(JINDEX+1)
33104      GOTO9000
33105C
33106C
33107C               ******************************************************
33108C               **  STEP 86--                                       **
33109C               **  TREAT THE POSTSCRIPT CASE                       **
33110C               **  BLACK AND WHITE DEVICE, HOWEVER CAN USE         **
33111C               **  "GREY SCALE" TO SIMULATE COLOR                  **
33112C               **  USED FOR REGIONS THAT ARE SOLID FILLED          **
33113C               **  REFERENCE--POSTSCRIPT LANGUAGE TUTORIAL AND     **
33114C               **  COOKBOOK FROM ADOBE SYSTEMS                     **
33115C               **  MODIFIED JANUARY, 1990 TO SUPPORT COLOR         **
33116C               ******************************************************
33117C
33118C     AUGUST 1990. SUPPORT FULL GRAY SCALE WITH THE FOLLOWING SCHEME.
33119C                  IF THE COLOR IS GIVEN AS A NEGATIVE INDEX FROM -1 TO
33120C                  -256 (I.E., -1, -2, ... , -256), INTERPERT THE NUMBER
33121C                  AS AN EXPLICIT GRAY SCALE INDEX.  POSITIVE INDEX
33122C                  NUMBERS (0 TO 15) WILL SUPPORT SPECIFIC COLORS AND WILL
33123C                  BE MAPPED TO EXPLICIT GRAY SCALES (NOT NECESSARILY
33124C                  SCALED BY NUMERIC VALUE) ON MONOCHROME DEVICES.
33125C
33126C     AUGUST 1992. ABOVE SCHEME NO LONGER APPLIES.  SUPPORT ALL 67 COLORS
33127C                  VIA SPECIFIC RGB VALUES, GRAY SCALE SPECIFIED VIA G0
33128C                  THROUGH G100  AS STATED IN BEGINING COMMENTS.  NO
33129C                  LONGER USE THE NEGATIVE VALUES SCHEME.
33130C
33131 8600 CONTINUE
33132      JCOL=2
33133      IF(JINDEX.LT.0)JCOL=JINDEX
33134      IF(IGCOLO.NE.'ON')GOTO9000
33135      IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
33136      GOTO9000
33137C
33138C
33139C               ******************************************************
33140C               **  STEP 91--                                       **
33141C               **  TREAT THE QUIC CASE (QMS, TELARIS LASER PRINTERS**
33142C               **  QUIC DOES NOT SUPPORT COLOR.  HOWEVER, IT DOES  **
33143C               **  SUPPORT "HALF-TONES" AND "FILL PATTERNS".  THESE**
33144C               **  ARE DESCRIBED IN CHAPTER 8 OF THE QMS QUIC      **
33145C               **  PROGRAMMERS MANUAL.  HOWEVER, THESE WILL NOT BE **
33146C               **  BE USED TO SIMULATE COLOR FOR REGION FILLS (AS  **
33147C               **  IN POSTSCRIPT AND PCL CASES).  THE REASON IS    **
33148C               **  POSTSCRIPT SUPPORTS GREYSCALE AS A DIRECTLY     **
33149C               **  SPECIFIED PROPORTION AND PCL SUPPORTS DOT       **
33150C               **  DENSITY AS A DIRECTLY SPECIFIED PERCENT.  THE   **
33151C               **  QMS HALFTONES ARE SPECIFIC PREDFINED PATTERNS,  **
33152C               **  THERE DID NOT SEEM TO BE A REASONABLE "PROGRESSION"
33153C               **  IN THE PATTERNS LISTED IN THE MANUAL.           **
33154C               ******************************************************
33155C
33156 9100 CONTINUE
33157      GOTO9000
33158C
33159C               ******************************************************
33160C               **  STEP 96--                                       **
33161C               **  TREAT THE X11        CASE                       **
33162C               ******************************************************
33163C
33164 9600 CONTINUE
33165      JCOL=0
33166      IF(JINDEX.LT.0)JCOL=JINDEX
33167      IF(JINDEX.GE.0)JCOL=JX11(JINDEX+1)
33168      GOTO9000
33169C
33170CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
33171C               *************************************************
33172C               **  STEP 100--                                 **
33173C               **  TREAT THE VGA VIA TURBO-C       CASE       **
33174C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
33175C               **             ENHANCEMENTS, PAGE 74.          **
33176C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
33177C               **             PAGE 310.                       **
33178C               *************************************************
33179C
3318010000 CONTINUE
33181      JCOL=0
33182      IF(JINDEX.LT.0)JCOL=0
33183      IF(JINDEX.GE.0)JCOL=JPC(JINDEX+1)
33184      GOTO9000
33185C
33186C               ******************************************************
33187C               **  STEP 110--                                      **
33188C               **  TREAT THE GKS                DRIVER             **
33189C               ******************************************************
33190C
3319111000 CONTINUE
33192      GOTO9000
33193C
33194C               ******************************************************
33195C               **  STEP 120--                                      **
33196C               **  TREAT THE GD                     DRIVER         **
33197C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
33198C               **  1) JPEG                                         **
33199C               **  2) PNG                                          **
33200C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
33201C               ******************************************************
33202C
3320312000 CONTINUE
33204C
33205      JCOL=0
33206      IF(JINDEX.LT.0)JCOL=JINDEX
33207      IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
33208      GOTO9000
33209C
33210C               ******************************************************
33211C               **  STEP 130--                                      **
33212C               **  TREAT THE ABSOFT                 DRIVER         **
33213C               ******************************************************
33214C
3321513000 CONTINUE
33216      JCOL=0
33217      IF(JINDEX.LT.0)JCOL=JINDEX
33218      IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
33219      GOTO9000
33220C
33221C               ******************************************************
33222C               **  STEP 135--                                      **
33223C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
33224C               ******************************************************
33225C
3322613500 CONTINUE
33227      JCOL=0
33228      IF(JINDEX.LT.0)JCOL=JINDEX
33229      IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
33230      GOTO9000
33231C
33232C
33233C               ******************************************************
33234C               **  STEP 150--                                      **
33235C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
33236C               ******************************************************
33237C
3323815000 CONTINUE
33239      GOTO9000
33240C
33241C               ******************************************************
33242C               **  STEP 160--                                      **
33243C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
33244C               ******************************************************
33245C
3324616000 CONTINUE
33247C
33248      JCOL=0
33249      IF(JINDEX.LT.0)JCOL=JINDEX
33250      IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
33251      GOTO9000
33252C
33253C               ******************************************************
33254C               **  STEP 170--                                      **
33255C               **  TREAT THE CAIRO                          DRIVER **
33256C               ******************************************************
33257C
3325817000 CONTINUE
33259      JCOL=0
33260      IF(JINDEX.LT.0)JCOL=JINDEX
33261      IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
33262      GOTO9000
33263C
33264C               ******************************************************
33265C               **  STEP 180--                                      **
33266C               **  TREAT THE WMF                            DRIVER **
33267C               ******************************************************
33268C
3326918000 CONTINUE
33270      JCOL=0
33271      IF(JINDEX.LT.0)JCOL=JINDEX
33272      IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
33273      GOTO9000
33274C
33275C               ******************************************************
33276C               **  STEP 190--                                      **
33277C               **  TREAT THE D3                             DRIVER **
33278C               ******************************************************
33279C
3328019000 CONTINUE
33281      JCOL=0
33282      IF(JINDEX.LT.0)JCOL=JINDEX
33283      IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1)
33284      GOTO9000
33285C
33286C               *****************
33287C               **  STEP 90--  **
33288C               **  EXIT       **
33289C               *****************
33290C
33291 9000 CONTINUE
33292      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRCO')THEN
33293        WRITE(ICOUT,999)
33294        CALL DPWRST('XXX','BUG ')
33295        WRITE(ICOUT,9011)
33296 9011   FORMAT('***** AT THE END       OF GRTRCO--')
33297        CALL DPWRST('XXX','BUG ')
33298        WRITE(ICOUT,9017)ICASE,ICOL,JCOL,JINDEX
33299 9017   FORMAT('ICASE,ICOL,JCOL,JINDEX = ',2(A4,2X),2I8)
33300        CALL DPWRST('XXX','BUG ')
33301      ENDIF
33302C
33303      RETURN
33304      END
33305      SUBROUTINE GRTRDI(ICASE,IDIR,ANGLE,JDIR,ANGLE2)
33306C
33307C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT,
33308C              TRANSLATE A DIRECTION GIVEN IN CHARACTER REPRESENTATION
33309C              INTO A NUMERIC REPRESENTATION
33310C              THAT WILL BE UNDERSTOOD BY A SPECIFIC
33311C              GRAPHICS DEVICE.
33312C
33313C     WRITTEN BY--JAMES J. FILLIBEN
33314C                 STATISTICAL ENGINEERING DIVISION
33315C                 INFORMATION TECHNOLOGY LABORATORY
33316C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
33317C                 GAITHERSBURG, MD 20899-8980
33318C                 PHONE--301-975-2855
33319C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
33320C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
33321C     LANGUAGE--ANSI FORTRAN (1977)
33322C     VERSION NUMBER--83.6
33323C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
33324C     UPDATED         --APRIL    2009. THIS CODE DOES NOT CONTAIN ANY
33325C                                      DEVICE SPECIFIC CODE, SO REMOVE
33326C                                      DEVICE DEPENDENT BRANCHES
33327C
33328C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
33329C
33330      CHARACTER*4 ICASE
33331      CHARACTER*4 IDIR
33332C
33333C-----COMMON----------------------------------------------------------
33334C
33335      INCLUDE 'DPCOGR.INC'
33336      INCLUDE 'DPCOBE.INC'
33337      INCLUDE 'DPCOP2.INC'
33338C
33339C-----START POINT-----------------------------------------------------
33340C
33341      IERRG4='NO'
33342C
33343      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRDI')THEN
33344        WRITE(ICOUT,999)
33345  999   FORMAT(1X)
33346        CALL DPWRST('XXX','BUG ')
33347        WRITE(ICOUT,51)
33348   51   FORMAT('***** AT THE BEGINNING OF GRTRDI--')
33349        CALL DPWRST('XXX','BUG ')
33350        WRITE(ICOUT,53)ICASE,IDIR,ANGLE
33351   53   FORMAT('ICASE,IDIR,ANGLE = ',2(A4,2X),G15.7)
33352        CALL DPWRST('XXX','BUG ')
33353        WRITE(ICOUT,54)IMANUF,IMODEL,IBUGG4
33354   54   FORMAT('IMANUF,IMODEL,IBUGG4 = ',2(A4,2X),A4)
33355        CALL DPWRST('XXX','BUG ')
33356      ENDIF
33357C
33358C               *************************************
33359C               **  STEP 0--                       **
33360C               **  DEFINE DIRECTION               **
33361C               **  FOR A GENERAL GRAPHICS DEVICE  **
33362C               *************************************
33363C
33364      JDIR=0
33365      ANGLE2=ANGLE
33366C
33367      IF(IDIR.EQ.'HORI')THEN
33368        JDIR=0
33369        ANGLE2=0.0
33370      ELSEIF(IDIR.EQ.'VERT')THEN
33371        JDIR=90
33372        ANGLE2=90.0
33373      ELSEIF(IDIR.EQ.'GENE')THEN
33374        JDIR=INT(ANGLE+0.5)
33375        ANGLE2=ANGLE
33376      ENDIF
33377C
33378C               *****************
33379C               **  STEP 90--  **
33380C               **  EXIT       **
33381C               *****************
33382C
33383      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRDI')THEN
33384        WRITE(ICOUT,999)
33385        CALL DPWRST('XXX','BUG ')
33386        WRITE(ICOUT,9011)
33387 9011   FORMAT('***** AT THE END       OF GRTRDI--')
33388        CALL DPWRST('XXX','BUG ')
33389        WRITE(ICOUT,9014)JDIR,ANGLE2,IERRG4
33390 9014   FORMAT('JDIR,ANGLE2,IERRG4 = ',I8,G15.7,2X,A4)
33391        CALL DPWRST('XXX','BUG ')
33392      ENDIF
33393C
33394      RETURN
33395      END
33396      SUBROUTINE GRTRFI(ICASE,IFILLT,JFILLT)
33397C
33398C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, TRANSLATE A FILL
33399C              SPECIFICATION (ON/OFF) GIVEN IN CHARACTER REPRESANTATION
33400C              INTO A NUMERIC REPRESENTATION THAT WILL BE UNDERSTOOD BY
33401C              A SPECIFIC GRAPHICS DEVICE.
33402C
33403C     WRITTEN BY--JAMES J. FILLIBEN
33404C                 STATISTICAL ENGINEERING DIVISION
33405C                 INFORMATION TECHNOLOGY LABORATORY
33406C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
33407C                 GAITHERSBURG, MD 20899-8980
33408C                 PHONE--301-975-2855
33409C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
33410C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
33411C     LANGUAGE--ANSI FORTRAN (1977)
33412C     VERSION NUMBER--83.6
33413C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
33414C     UPDATED         --APRIL    2009. THIS CODE DOES NOT CONTAIN ANY
33415C                                      DEVICE SPECIFIC CODE, SO REMOVE
33416C                                      DEVICE DEPENDENT BRANCHES
33417C
33418C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
33419C
33420      CHARACTER*4 ICASE
33421      CHARACTER*4 IFILLT
33422C
33423C-----COMMON----------------------------------------------------------
33424C
33425      INCLUDE 'DPCOGR.INC'
33426      INCLUDE 'DPCOBE.INC'
33427      INCLUDE 'DPCOP2.INC'
33428C
33429C-----START POINT-----------------------------------------------------
33430C
33431      IERRG4='NO'
33432C
33433      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRFI')THEN
33434        WRITE(ICOUT,999)
33435  999   FORMAT(1X)
33436        CALL DPWRST('XXX','BUG ')
33437        WRITE(ICOUT,51)
33438   51   FORMAT('***** AT THE BEGINNING OF GRTRFI--')
33439        CALL DPWRST('XXX','BUG ')
33440        WRITE(ICOUT,53)ICASE,IFILLT
33441   53   FORMAT('ICASE,IFILLT = ',A4,2X,A4)
33442        CALL DPWRST('XXX','BUG ')
33443        WRITE(ICOUT,54)IMANUF,IMODEL,IBUGG4
33444   54   FORMAT('IMANUF,IMODEL,IBUGG4 = ',2(A4,2X),A4)
33445        CALL DPWRST('XXX','BUG ')
33446      ENDIF
33447C
33448C               *************************************
33449C               **  STEP 0--                       **
33450C               **  DEFINE FILL                    **
33451C               **  FOR A GENERAL GRAPHICS DEVICE  **
33452C               *************************************
33453C
33454      JFILLT=0
33455      IF(IFILLT.EQ.'ON')JFILLT=1
33456C
33457C               *****************
33458C               **  STEP 90--  **
33459C               **  EXIT       **
33460C               *****************
33461C
33462      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRFI')THEN
33463        WRITE(ICOUT,999)
33464        CALL DPWRST('XXX','BUG ')
33465        WRITE(ICOUT,9011)
33466 9011   FORMAT('***** AT THE END       OF GRTRFI--')
33467        CALL DPWRST('XXX','BUG ')
33468        WRITE(ICOUT,9013)IERRG4,ICASE,IFILLT,JFILLT
33469 9013   FORMAT('IERRG4,ICASE,IFILLT,JFILLT = ',3(A4,2X),I8)
33470        CALL DPWRST('XXX','BUG ')
33471      ENDIF
33472C
33473      RETURN
33474      END
33475      SUBROUTINE GRTRFO(ICASE,IFONT,JFONT)
33476C
33477C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, TRANSLATE A FONT
33478C              GIVEN IN CHARACTER REPRESENTATION INTO A NUMERIC
33479C              REPRESENTATION THAT WILL BE UNDERSTOOD BY A SPECIFIC
33480C              GRAPHICS DEVICE.
33481C
33482C     WRITTEN BY--JAMES J. FILLIBEN
33483C                 STATISTICAL ENGINEERING DIVISION
33484C                 INFORMATION TECHNOLOGY LABORATORY
33485C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
33486C                 GAITHERSBURG, MD 20899-8980
33487C                 PHONE--301-975-2855
33488C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
33489C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
33490C     LANGUAGE--ANSI FORTRAN (1977)
33491C     VERSION NUMBER--83.6
33492C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
33493C     UPDATED         --APRIL    2009. THIS CODE DOES NOT CONTAIN ANY
33494C                                      DEVICE SPECIFIC CODE, SO REMOVE
33495C                                      DEVICE DEPENDENT BRANCHES
33496C
33497C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
33498C
33499      CHARACTER*4 ICASE
33500      CHARACTER*4 IFONT
33501C
33502C-----COMMON----------------------------------------------------------
33503C
33504      INCLUDE 'DPCOGR.INC'
33505      INCLUDE 'DPCOBE.INC'
33506      INCLUDE 'DPCOP2.INC'
33507C
33508C-----START POINT-----------------------------------------------------
33509C
33510      IERRG4='NO'
33511C
33512      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRFO')THEN
33513        WRITE(ICOUT,999)
33514  999   FORMAT(1X)
33515        CALL DPWRST('XXX','BUG ')
33516        WRITE(ICOUT,51)
33517   51   FORMAT('***** AT THE BEGINNING OF GRTRFO--')
33518        CALL DPWRST('XXX','BUG ')
33519        WRITE(ICOUT,54)ICASE,IFONT,IMANUF,IMODEL,IBUGG4
33520   54   FORMAT('ICASE,IFONT,IMANUF,IMODEL,IBUGG4 = ',4(A4,2X),A4)
33521        CALL DPWRST('XXX','BUG ')
33522      ENDIF
33523C
33524C               *************************************
33525C               **  STEP 0--                       **
33526C               **  DEFINE FONT                    **
33527C               **  FOR A GENERAL GRAPHICS DEVICE  **
33528C               *************************************
33529C
33530      JFONT=0
33531      IF(IFONT.EQ.'TEKT')JFONT=0
33532      IF(IFONT.EQ.'SIMP')JFONT=1
33533      IF(IFONT.EQ.'DUPL')JFONT=2
33534      IF(IFONT.EQ.'TRIP')JFONT=3
33535      IF(IFONT.EQ.'COMP')JFONT=4
33536      IF(IFONT.EQ.'TRII')JFONT=5
33537      IF(IFONT.EQ.'SIMS')JFONT=6
33538      IF(IFONT.EQ.'COMS')JFONT=7
33539C
33540C               *****************
33541C               **  STEP 90--  **
33542C               **  EXIT       **
33543C               *****************
33544C
33545      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRFO')THEN
33546        WRITE(ICOUT,999)
33547        CALL DPWRST('XXX','BUG ')
33548        WRITE(ICOUT,9011)
33549 9011   FORMAT('***** AT THE END       OF GRTRFO--')
33550        CALL DPWRST('XXX','BUG ')
33551        WRITE(ICOUT,9013)IERRG4,IFONT,JFONT
33552 9013   FORMAT('IERRG4,IFONT,JFONT = ',2(A4,2X),I8)
33553        CALL DPWRST('XXX','BUG ')
33554      ENDIF
33555C
33556      RETURN
33557      END
33558      SUBROUTINE GRTRJU(ICASE,IJUST,JJUST)
33559C
33560C     PURPOSE--FOR A TEXT STRING, MARKER, LINE, OR AREA, TRANSLATE A
33561C              JUSTIFICATION GIVEN IN CHARACTER REPRESENTATION INTO A
33562C              NUMERIC REPRESENTATION THAT WILL BE UNDERSTOOD BY A
33563C              SPECIFIC GRAPHICS DEVICE.
33564C
33565C     WRITTEN BY--JAMES J. FILLIBEN
33566C                 STATISTICAL ENGINEERING DIVISION
33567C                 INFORMATION TECHNOLOGY LABORATORY
33568C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
33569C                 GAITHERSBURG, MD 20899-8980
33570C                 PHONE--301-975-2855
33571C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
33572C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
33573C     LANGUAGE--ANSI FORTRAN (1977)
33574C     VERSION NUMBER--83.6
33575C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
33576C     UPDATED         --APRIL    2009. THIS CODE DOES NOT CONTAIN ANY
33577C                                      DEVICE SPECIFIC CODE, SO REMOVE
33578C                                      DEVICE DEPENDENT BRANCHES
33579C
33580C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
33581C
33582      CHARACTER*4 ICASE
33583      CHARACTER*4 IJUST
33584C
33585C-----COMMON----------------------------------------------------------
33586C
33587      INCLUDE 'DPCOGR.INC'
33588      INCLUDE 'DPCOBE.INC'
33589      INCLUDE 'DPCOP2.INC'
33590C
33591C-----START POINT-----------------------------------------------------
33592C
33593      IERRG4='NO'
33594C
33595      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRJU')THEN
33596        WRITE(ICOUT,999)
33597  999   FORMAT(1X)
33598        CALL DPWRST('XXX','BUG ')
33599        WRITE(ICOUT,51)
33600   51   FORMAT('***** AT THE BEGINNING OF GRTRJU--')
33601        CALL DPWRST('XXX','BUG ')
33602        WRITE(ICOUT,54)ICASE,IJUST,IMANUF,IMODEL,IBUGG4
33603   54   FORMAT('ICASE,IJUST,IMANUF,IMODEL,IBUGG4 = ',4(A4,2X),A4)
33604        CALL DPWRST('XXX','BUG ')
33605      ENDIF
33606C
33607C               *************************************
33608C               **  STEP 0--                       **
33609C               **  DEFINE JUSTIFICATION           **
33610C               **  FOR A GENERAL GRAPHICS DEVICE  **
33611C               *************************************
33612C
33613      JJUST=1
33614      IF(IJUST.EQ.'LEFT')JJUST=1
33615      IF(IJUST.EQ.'CENT')JJUST=2
33616      IF(IJUST.EQ.'RIGH')JJUST=3
33617C
33618      IF(IJUST.EQ.'LJUS')JJUST=1
33619      IF(IJUST.EQ.'CJUS')JJUST=2
33620      IF(IJUST.EQ.'RJUS')JJUST=3
33621C
33622      IF(IJUST.EQ.'LEBO')JJUST=1
33623      IF(IJUST.EQ.'CEBO')JJUST=2
33624      IF(IJUST.EQ.'RIBO')JJUST=3
33625      IF(IJUST.EQ.'LECE')JJUST=4
33626      IF(IJUST.EQ.'CECE')JJUST=5
33627      IF(IJUST.EQ.'RICE')JJUST=6
33628      IF(IJUST.EQ.'LETO')JJUST=7
33629      IF(IJUST.EQ.'CETO')JJUST=8
33630      IF(IJUST.EQ.'RITO')JJUST=9
33631C
33632C               *****************
33633C               **  STEP 90--  **
33634C               **  EXIT       **
33635C               *****************
33636C
33637      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRJU')THEN
33638        WRITE(ICOUT,999)
33639        CALL DPWRST('XXX','BUG ')
33640        WRITE(ICOUT,9011)
33641 9011   FORMAT('***** AT THE END       OF GRTRJU--')
33642        CALL DPWRST('XXX','BUG ')
33643        WRITE(ICOUT,9019)IERRG4,IJUST,JJUST
33644 9019   FORMAT('IERRG4,IJUST,JJUST = ',2(A4,2X),I8)
33645        CALL DPWRST('XXX','BUG ')
33646      ENDIF
33647C
33648      RETURN
33649      END
33650      SUBROUTINE GRTRPA(ICASE,IPATTT,PXSPA,PYSPA,
33651     1JPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2)
33652C
33653C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, TRANSLATE A PATTERN
33654C              IN CHARACTER REPRESENTTION.  INTO A NUMERIC REPRESENTATION
33655C              THAT WILL BE UNDERSTOOD BY THE SPECIFIC GRAPHICS DEVICE.
33656C
33657C     WRITTEN BY--JAMES J. FILLIBEN
33658C                 STATISTICAL ENGINEERING DIVISION
33659C                 INFORMATION TECHNOLOGY LABORATORY
33660C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
33661C                 GAITHERSBURG, MD 20899-8980
33662C                 PHONE--301-975-2855
33663C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
33664C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
33665C     LANGUAGE--ANSI FORTRAN (1977)
33666C     VERSION NUMBER--83.6
33667C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
33668C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
33669C                                      DRIVER OBSOLETE
33670C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
33671C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
33672C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
33673C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
33674C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
33675C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
33676C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
33677C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
33678C                                      DRIVER OBSOLETE
33679C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
33680C                                      OLD CALCOMP STYLE
33681C                                      DRIVER OBSOLETE
33682C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
33683C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
33684C                                      USE BILL MITCHELLS OPENGL
33685C                                      BINDING FOR FORTRAN
33686C     UPDATED         --OCTOBER  1996. GKS (ALAN)
33687C                                      CODED, NOT TESTED
33688C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
33689C                                      PLACEHOLDER FOR NOW
33690C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
33691C                                      PLACEHOLDER FOR NOW
33692C     UPDATED         --OCTOBER  1996. SET PATTERN TO -1 FOR BLANK LINE
33693C                                      IF DEVICE DOESN'T ALREADY SET
33694C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
33695C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
33696C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
33697C     UPDATED         --JUNE     2000. MACINTOSH
33698C                                      PLACEHOLDER FOR NOW
33699C                     --MARCH    2002. CHANGE TO QUARTZ (NEW MAC GRAPHICS
33700C                                      LIBRARY)
33701C     UPDATED         --JUNE     2000. PC PRINTER
33702C                                      PLACEHOLDER FOR NOW
33703C                     --MARCH    2002. CHANGE TO GHOSTSCRIPT
33704C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
33705C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
33706C     UPDATED         --FEBRUARY 2006. LATEX
33707C     UPDATED         --APRIL    2009. IMPLEMENT LIBPLOT DRIVER
33708C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
33709C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
33710C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
33711C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
33712C                                      GRAPHICS DEVICES
33713C
33714C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
33715C
33716      CHARACTER*4 ICASE
33717      CHARACTER*4 IPATTT
33718      CHARACTER*4 IHORPA
33719      CHARACTER*4 IVERPA
33720      CHARACTER*4 IDUPPA
33721      CHARACTER*4 IDDOPA
33722C
33723C-----COMMON----------------------------------------------------------
33724C
33725      INCLUDE 'DPCOGR.INC'
33726      INCLUDE 'DPCOBE.INC'
33727      INCLUDE 'DPCOST.INC'
33728      INCLUDE 'DPCODV.INC'
33729      INCLUDE 'DPCOP2.INC'
33730C
33731C-----START POINT-----------------------------------------------------
33732C
33733      IERRG4='NO'
33734C
33735      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRPA')THEN
33736        WRITE(ICOUT,999)
33737  999   FORMAT(1X)
33738        CALL DPWRST('XXX','BUG ')
33739        WRITE(ICOUT,51)
33740   51   FORMAT('***** AT THE BEGINNING OF GRTRPA--')
33741        CALL DPWRST('XXX','BUG ')
33742        WRITE(ICOUT,53)ICASE,IPATTT,IMANUF,IMODEL,IBUGG4
33743   53   FORMAT('ICASE,IPATTT,IMANUF,IMODEL,IBUGG4 = ',4(A4,2X),A4)
33744        CALL DPWRST('XXX','BUG ')
33745        WRITE(ICOUT,54)PXSPA,PYSPA
33746   54   FORMAT('PXSPA,PYSPA = ',2G15.7)
33747        CALL DPWRST('XXX','BUG ')
33748      ENDIF
33749C
33750C               ********************************************
33751C               **  STEP 1--                              **
33752C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
33753C               **  AND THE MODEL                         **
33754C               ********************************************
33755C
33756      IF(IMANUF.EQ.'QWIN')THEN
33757        GOTO4700
33758      ELSEIF(IMANUF.EQ.'POST')THEN
33759        GOTO8600
33760      ELSEIF(IMANUF.EQ.'X11 ')THEN
33761        GOTO9600
33762      ELSEIF(IMANUF.EQ.'AQUA')THEN
33763        GOTO13500
33764      ELSEIF(IMANUF.EQ.'GENE')THEN
33765        IF(IMODEL.EQ.'CGM')GOTO3300
33766        IF(IMODEL.EQ.'CGMB')GOTO3400
33767        GOTO3100
33768      ELSEIF(IMANUF.EQ.'SVG ')THEN
33769        GOTO16000
33770      ELSEIF(IMANUF.EQ.'GD  ')THEN
33771        GOTO12000
33772      ELSEIF(IMANUF.EQ.'LATE')THEN
33773        GOTO15000
33774      ELSEIF(IMANUF.EQ.'CAIR')THEN
33775        GOTO17000
33776      ELSEIF(IMANUF.EQ.'D3  ')THEN
33777        GOTO19000
33778      ELSEIF(IMANUF.EQ.'WMF ')THEN
33779        GOTO18000
33780      ELSEIF(IMANUF.EQ.'OPGL')THEN
33781        GOTO4800
33782      ELSEIF(IMANUF.EQ.'TEKT')THEN
33783        IF(IMODEL.EQ.'4020')GOTO1200
33784        IF(IMODEL.EQ.'4022')GOTO1200
33785        IF(IMODEL.EQ.'4025')GOTO1200
33786        IF(IMODEL.EQ.'4027')GOTO1200
33787C
33788        IF(IMODEL.EQ.'4105')GOTO1300
33789        IF(IMODEL.EQ.'4107')GOTO1300
33790        IF(IMODEL.EQ.'4109')GOTO1300
33791        IF(IMODEL.EQ.'4115')GOTO1300
33792        IF(IMODEL.EQ.'4107')GOTO1300
33793        IF(IMODEL.EQ.'4113')GOTO1300
33794C
33795        GOTO1100
33796      ELSEIF(IMANUF.EQ.'HP')THEN
33797        IF(IMODEL.EQ.'7221')GOTO2100
33798        IF(IMODEL.EQ.'2622')GOTO2300
33799        IF(IMODEL.EQ.'2623')GOTO2300
33800        IF(IMODEL.EQ.'2627')GOTO2300
33801        IF(IMODEL.EQ.'2647')GOTO2300
33802        GOTO2200
33803      ELSEIF(IMANUF.EQ.'LIBP')THEN
33804        GOTO2600
33805      ELSEIF(IMANUF.EQ.'REGI')THEN
33806        GOTO8100
33807      ELSEIF(IMANUF.EQ.'GKS ')THEN
33808        GOTO11000
33809      ELSEIF(IMANUF.EQ.'LAHE')THEN
33810        IF(IMODEL.EQ.'INTE')GOTO4900
33811        IF(IMODEL.EQ.'WINT')GOTO4950
33812        GOTO4600
33813      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
33814        GOTO13000
33815      ELSEIF(IMANUF.EQ.'QUIC')THEN
33816        GOTO9100
33817      ELSEIF(IMANUF.EQ.'CALC')THEN
33818        GOTO4100
33819      ELSEIF(IMANUF.EQ.'ZETA')THEN
33820        GOTO5100
33821      ELSEIF(IMANUF.EQ.'TURB')THEN
33822        GOTO10000
33823      ELSEIF(IMANUF.EQ.'SUN ')THEN
33824        GOTO6600
33825      ENDIF
33826      GOTO9000
33827C
33828C               *******************************************
33829C               **  STEP 11--                            **
33830C               **  TREAT THE TEKTRONIX 4014             **
33831C               **  REFERENCE--40Z105 MANUAL, PAGE 5-52  **
33832C               *******************************************
33833C
33834 1100 CONTINUE
33835      IF(ICASE.EQ.'REGI')THEN
33836        GOTO8000
33837      ELSEIF(ICASE.EQ.'MARK')THEN
33838        GOTO9000
33839      ELSEIF(ICASE.EQ.'TEXT')THEN
33840        GOTO9000
33841      ELSE
33842        JPATTT=96
33843        IF(IPATTT.EQ.'SOLI')JPATTT=96
33844        IF(IPATTT.EQ.'SO')JPATTT=96
33845        IF(IPATTT.EQ.'DOTT')JPATTT=97
33846        IF(IPATTT.EQ.'DOT')JPATTT=97
33847        IF(IPATTT.EQ.'DO')JPATTT=97
33848        IF(IPATTT.EQ.'DASH')JPATTT=99
33849        IF(IPATTT.EQ.'DA')JPATTT=99
33850        IF(IPATTT.EQ.'DA1')JPATTT=100
33851        IF(IPATTT.EQ.'DA2')JPATTT=98
33852        IF(IPATTT.EQ.'DA3')JPATTT=102
33853        IF(IPATTT.EQ.'DA4')JPATTT=101
33854        IF(IPATTT.EQ.'DA5')JPATTT=103
33855        IF(IPATTT.EQ.'BLAN')JPATTT=-1
33856        IF(IPATTT.EQ.'BL  ')JPATTT=-1
33857        IF(IPATTT.EQ.'NONE')JPATTT=-1
33858        IF(IPATTT.EQ.'NO  ')JPATTT=-1
33859        IF(IPATTT.EQ.'    ')JPATTT=-1
33860      ENDIF
33861      GOTO9000
33862C
33863C               ****************************************************
33864C               **  STEP 12--                                     **
33865C               **  TREAT THE TEKTRONIX 4027                      **
33866C               **  (COLOR RASTER DEVICE).                        **
33867C               **  TO SET LINE PATTERN,                          **
33868C               **  XXX                                           **
33869C               **  REFERENCE--4027 OPERATOR'S MANUAL, PAGE XXX.  **
33870C               ****************************************************
33871C
33872 1200 CONTINUE
33873      IF(ICASE.EQ.'REGI')THEN
33874        GOTO8000
33875      ELSEIF(ICASE.EQ.'MARK')THEN
33876        GOTO9000
33877      ELSEIF(ICASE.EQ.'TEXT')THEN
33878        GOTO9000
33879      ELSE
33880        JPATTT=1
33881        IF(IPATTT.EQ.'SOLI')JPATTT=1
33882        IF(IPATTT.EQ.'SO')JPATTT=1
33883        IF(IPATTT.EQ.'DASH')JPATTT=2
33884        IF(IPATTT.EQ.'DA')JPATTT=2
33885        IF(IPATTT.EQ.'DOTT')JPATTT=3
33886        IF(IPATTT.EQ.'DOT')JPATTT=3
33887        IF(IPATTT.EQ.'DO')JPATTT=3
33888        IF(IPATTT.EQ.'DA1')JPATTT=4
33889        IF(IPATTT.EQ.'DA2')JPATTT=5
33890        IF(IPATTT.EQ.'DA3')JPATTT=6
33891        IF(IPATTT.EQ.'DA4')JPATTT=7
33892        IF(IPATTT.EQ.'DA5')JPATTT=8
33893        IF(IPATTT.EQ.'BLAN')JPATTT=-1
33894        IF(IPATTT.EQ.'BL  ')JPATTT=-1
33895        IF(IPATTT.EQ.'NONE')JPATTT=-1
33896        IF(IPATTT.EQ.'NO  ')JPATTT=-1
33897        IF(IPATTT.EQ.'    ')JPATTT=-1
33898      ENDIF
33899      GOTO9000
33900C
33901C               *************************************
33902C               **  STEP 13--                      **
33903C               **  TREAT THE TEKTRONIX 4105 CASE  **
33904C               **  (COLOR RASTER DEVICE)          **
33905C               **  REFERENCE--XXX                 **
33906C               *************************************
33907C
33908 1300 CONTINUE
33909      IF(ICASE.EQ.'REGI')THEN
33910        CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
33911        PXSPA2=PXSPA
33912        PYSPA2=PYSPA
33913CCCCC   IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
33914CCCCC   IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
33915CCCCC   IF(IPATTT.EQ.'FILL')PXSPA2=0.1
33916CCCCC   IF(IPATTT.EQ.'FILL')PYSPA2=0.1
33917      ELSEIF(ICASE.EQ.'MARK')THEN
33918        GOTO9000
33919      ELSEIF(ICASE.EQ.'TEXT')THEN
33920        GOTO9000
33921      ELSE
33922        JPATTT=96
33923        IF(IPATTT.EQ.'SOLI')JPATTT=96
33924        IF(IPATTT.EQ.'SO')JPATTT=96
33925        IF(IPATTT.EQ.'DOTT')JPATTT=97
33926        IF(IPATTT.EQ.'DOT')JPATTT=97
33927        IF(IPATTT.EQ.'DO')JPATTT=97
33928        IF(IPATTT.EQ.'DASH')JPATTT=99
33929        IF(IPATTT.EQ.'DA')JPATTT=99
33930        IF(IPATTT.EQ.'DA1')JPATTT=100
33931        IF(IPATTT.EQ.'DA2')JPATTT=98
33932        IF(IPATTT.EQ.'DA3')JPATTT=102
33933        IF(IPATTT.EQ.'DA4')JPATTT=101
33934        IF(IPATTT.EQ.'DA5')JPATTT=103
33935        IF(IPATTT.EQ.'BLAN')JPATTT=-1
33936        IF(IPATTT.EQ.'BL  ')JPATTT=-1
33937        IF(IPATTT.EQ.'NONE')JPATTT=-1
33938        IF(IPATTT.EQ.'NO  ')JPATTT=-1
33939        IF(IPATTT.EQ.'    ')JPATTT=-1
33940      ENDIF
33941      GOTO9000
33942C
33943C               ****************************************************
33944C               **  STEP 21--                                     **
33945C               **  TREAT THE HEWLETT-PACKARD 7221 CASE           **
33946C               **  (MULTI-COLOR PENPLOTTER)                      **
33947C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER          **
33948C               **             OPERATING AND PROGRAMMING MANUAL,  **
33949C               **             PAGE XX.                           **
33950C               ****************************************************
33951C
33952 2100 CONTINUE
33953      IF(ICASE.EQ.'REGI')THEN
33954        GOTO8000
33955      ELSEIF(ICASE.EQ.'MARK')THEN
33956        GOTO9000
33957      ELSEIF(ICASE.EQ.'TEXT')THEN
33958        GOTO9000
33959      ELSE
33960        GOTO9000
33961      ENDIF
33962      GOTO9000
33963C
33964C               ****************************************************
33965C               **  STEP 22--                                     **
33966C               **  TREAT THE HEWLETT-PACKARD HP-GL CASE          **
33967C               **  (MULTI-COLOR PENPLOTTER)                      **
33968C               **  REFERENCE--                                   **
33969C               **                                                **
33970C               **             PAGE XX.                           **
33971C               ****************************************************
33972C
33973 2200 CONTINUE
33974      IF(ICASE.EQ.'REGI')THEN
33975        GOTO8000
33976      ELSEIF(ICASE.EQ.'MARK')THEN
33977        GOTO9000
33978      ELSEIF(ICASE.EQ.'TEXT')THEN
33979        GOTO9000
33980      ELSE
33981        JPATTT=-1
33982        IF(IPATTT.EQ.'BLAN')JPATTT=0
33983        IF(IPATTT.EQ.'BL  ')JPATTT=0
33984        IF(IPATTT.EQ.'NONE')JPATTT=0
33985        IF(IPATTT.EQ.'NO  ')JPATTT=0
33986        IF(IPATTT.EQ.'    ')JPATTT=0
33987        IF(IPATTT.EQ.'SOLI')JPATTT=-1
33988        IF(IPATTT.EQ.'SO  ')JPATTT=-1
33989        IF(IPATTT.EQ.'DOTT')JPATTT=1
33990        IF(IPATTT.EQ.'DOT ')JPATTT=1
33991        IF(IPATTT.EQ.'DO  ')JPATTT=1
33992        IF(IPATTT.EQ.'DASH')JPATTT=2
33993        IF(IPATTT.EQ.'DA  ')JPATTT=2
33994        IF(IPATTT.EQ.'DA1 ')JPATTT=3
33995        IF(IPATTT.EQ.'DA2 ')JPATTT=4
33996        IF(IPATTT.EQ.'DA3 ')JPATTT=5
33997        IF(IPATTT.EQ.'DA4 ')JPATTT=6
33998      ENDIF
33999      GOTO9000
34000C
34001C               **********************************************************
34002C               **  STEP 23--                                           **
34003C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
34004C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
34005C               **  (MONOCHROME DISPLAY TERMINALS)                      **
34006C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
34007C               **             REFERENCE MANUAL,                        **
34008C               **             PAGE 10-6, 10-7.                         **
34009C               **********************************************************
34010C
34011 2300 CONTINUE
34012      IF(ICASE.EQ.'REGI')THEN
34013        GOTO8000
34014      ELSEIF(ICASE.EQ.'MARK')THEN
34015        GOTO9000
34016      ELSEIF(ICASE.EQ.'TEXT')THEN
34017        GOTO9000
34018      ELSE
34019        JPATTT=1
34020        IF(IPATTT.EQ.'BLAN')JPATTT=11
34021        IF(IPATTT.EQ.'BL  ')JPATTT=11
34022        IF(IPATTT.EQ.'NONE')JPATTT=11
34023        IF(IPATTT.EQ.'NO  ')JPATTT=11
34024        IF(IPATTT.EQ.'    ')JPATTT=11
34025        IF(IPATTT.EQ.'SOLI')JPATTT=1
34026        IF(IPATTT.EQ.'SO  ')JPATTT=1
34027        IF(IPATTT.EQ.'DOTT')JPATTT=7
34028        IF(IPATTT.EQ.'DOT ')JPATTT=7
34029        IF(IPATTT.EQ.'DO  ')JPATTT=7
34030        IF(IPATTT.EQ.'DASH')JPATTT=6
34031        IF(IPATTT.EQ.'DA  ')JPATTT=6
34032        IF(IPATTT.EQ.'DA1 ')JPATTT=5
34033        IF(IPATTT.EQ.'DA2 ')JPATTT=4
34034        IF(IPATTT.EQ.'DA3 ')JPATTT=10
34035        IF(IPATTT.EQ.'DA4 ')JPATTT=8
34036      ENDIF
34037      GOTO9000
34038C
34039C               **********************************************************
34040C               **  STEP 26--                                           **
34041C               **  TREAT THE UNIX LIBPLOT            CASE              **
34042C               **********************************************************
34043C
34044 2600 CONTINUE
34045      IF(ICASE.EQ.'REGI')THEN
34046        GOTO8000
34047      ELSEIF(ICASE.EQ.'MARK')THEN
34048        GOTO9000
34049      ELSEIF(ICASE.EQ.'TEXT')THEN
34050        GOTO9000
34051      ELSE
34052        JPATT=0
34053        IF(IPATTT.EQ.'BLAN')JPATTT=-1
34054        IF(IPATTT.EQ.'BL  ')JPATTT=-1
34055        IF(IPATTT.EQ.'NONE')JPATTT=-1
34056        IF(IPATTT.EQ.'NO  ')JPATTT=-1
34057        IF(IPATTT.EQ.'    ')JPATTT=-1
34058        IF(IPATTT.EQ.'SOLI')JPATTT=0
34059        IF(IPATTT.EQ.'SO  ')JPATTT=0
34060        IF(IPATTT.EQ.'DOTT')JPATTT=2
34061        IF(IPATTT.EQ.'DOT ')JPATTT=2
34062        IF(IPATTT.EQ.'DO  ')JPATTT=2
34063        IF(IPATTT.EQ.'DASH')JPATTT=1
34064        IF(IPATTT.EQ.'DA  ')JPATTT=1
34065        IF(IPATTT.EQ.'DA2 ')JPATTT=3
34066        IF(IPATTT.EQ.'DA3 ')JPATTT=4
34067        IF(IPATTT.EQ.'DA4 ')JPATTT=5
34068        IF(IPATTT.EQ.'DA5 ')JPATTT=6
34069      ENDIF
34070      GOTO9000
34071C
34072C               ***************************************************
34073C               **  STEP 31--                                    **
34074C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE  **
34075C               ***************************************************
34076C
34077 3100 CONTINUE
34078      IF(ICASE.EQ.'REGI')THEN
34079        CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
34080        PXSPA2=PXSPA
34081        PYSPA2=PYSPA
34082        IF(IPATTT.EQ.'SOLI')PXSPA2=PPENSW
34083        IF(IPATTT.EQ.'SOLI')PYSPA2=PPENSW
34084        IF(IPATTT.EQ.'FILL')PXSPA2=PPENSW
34085        IF(IPATTT.EQ.'FILL')PYSPA2=PPENSW
34086      ELSEIF(ICASE.EQ.'MARK')THEN
34087        GOTO9000
34088      ELSEIF(ICASE.EQ.'TEXT')THEN
34089        GOTO9000
34090      ELSE
34091        GOTO9000
34092      ENDIF
34093      GOTO9000
34094C
34095C
34096C               ******************************************************
34097C               **  STEP 33--                                       **
34098C               **  TREAT THE CGM       CASE                        **
34099C               **  LINE                                            **
34100C               **    1 - SOLID                                     **
34101C               **    2 - DASH                                      **
34102C               **    3 - DOT                                       **
34103C               **    4 - DASH-DOT                                  **
34104C               **    5 - DASH-DOT-DOT                              **
34105C               **  REGION                                          **
34106C               **    1 - PARALLEL HORIZONTAL LINES                 **
34107C               **    2 - PARALLEL VERTICAL LINES                   **
34108C               **    3 - 45 DEGREE LINES                           **
34109C               **    4 - 135 DEGREE LINES                          **
34110C               **    5 - CROSS-HATCH WITH 45 AND 135 DEGREE LINES  **
34111C               **  MARKERS AND TEXT PATTERNS NOT CURRENTLY         **
34112C               **  UTILIZED BY DATAPLOT                            **
34113C               ******************************************************
34114C
34115 3300 CONTINUE
34116      IF(ICASE.EQ.'REGI')THEN
34117C
34118C       NOTE: PPENSW IS THE WIDTH OF A SINGLE LINE FOR METAFILES.
34119C             USER SETTABLE VIA "SET GENERAL PEN WIDTH <WIDTH>"
34120C
34121        CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
34122        JPATTT=0
34123        IF(IPATTT.EQ.'SOLI')JPATTT=0
34124        IF(IPATTT.EQ.'FILL')JPATTT=0
34125        IF(IPATTT.EQ.'HORI')JPATTT=1
34126        IF(IPATTT.EQ.'VERT')JPATTT=2
34127        IF(IPATTT.EQ.'D1')JPATTT=3
34128        IF(IPATTT.EQ.'D2')JPATTT=4
34129        IF(IPATTT.EQ.'HV')JPATTT=5
34130        IF(IPATTT.EQ.'D1D2')JPATTT=6
34131        IF(IPATTT.EQ.'HD1')JPATTT=6
34132        IF(IPATTT.EQ.'HD2')JPATTT=6
34133        IF(IPATTT.EQ.'VD1')JPATTT=6
34134        IF(IPATTT.EQ.'VD2')JPATTT=6
34135        IF(IPATTT.EQ.'HVD1')JPATTT=6
34136        IF(IPATTT.EQ.'HVD2')JPATTT=6
34137        IF(IPATTT.EQ.'ALL')JPATTT=6
34138        PXSPA2=PXSPA
34139        PYSPA2=PYSPA
34140        IF(IPATTT.EQ.'SOLI')PXSPA2=PPENSW
34141        IF(IPATTT.EQ.'SOLI')PYSPA2=PPENSW
34142        IF(IPATTT.EQ.'FILL')PXSPA2=PPENSW
34143        IF(IPATTT.EQ.'FILL')PYSPA2=PPENSW
34144      ELSEIF(ICASE.EQ.'MARK')THEN
34145        GOTO9000
34146      ELSEIF(ICASE.EQ.'TEXT')THEN
34147        GOTO9000
34148      ELSE
34149        JPATT=1
34150        IF(IPATTT.EQ.'BLAN')JPATTT=0
34151        IF(IPATTT.EQ.'BL  ')JPATTT=0
34152        IF(IPATTT.EQ.'NONE')JPATTT=0
34153        IF(IPATTT.EQ.'NO  ')JPATTT=0
34154        IF(IPATTT.EQ.'    ')JPATTT=0
34155        IF(IPATTT.EQ.'SOLI')JPATTT=1
34156        IF(IPATTT.EQ.'SO  ')JPATTT=1
34157        IF(IPATTT.EQ.'DOTT')JPATTT=3
34158        IF(IPATTT.EQ.'DOT ')JPATTT=3
34159        IF(IPATTT.EQ.'DO  ')JPATTT=3
34160        IF(IPATTT.EQ.'DASH')JPATTT=2
34161        IF(IPATTT.EQ.'DA  ')JPATTT=2
34162        IF(IPATTT.EQ.'DA1 ')JPATTT=4
34163        IF(IPATTT.EQ.'DA2 ')JPATTT=5
34164        IF(IPATTT.EQ.'DA3 ')JPATTT=4
34165        IF(IPATTT.EQ.'DA4 ')JPATTT=5
34166      ENDIF
34167      GOTO9000
34168C
34169C
34170C               ***************************************************
34171C               **  STEP 34--                                    **
34172C               **  TREAT THE CGM (BINARY)                 CASE  **
34173C               ***************************************************
34174C
34175 3400 CONTINUE
34176      IF(ICASE.EQ.'REGI')THEN
34177        GOTO8000
34178      ELSEIF(ICASE.EQ.'MARK')THEN
34179        GOTO9000
34180      ELSEIF(ICASE.EQ.'TEXT')THEN
34181        GOTO9000
34182      ELSE
34183      ENDIF
34184      GOTO9000
34185C
34186C               ******************************************************
34187C               **  STEP 41--                                       **
34188C               **  TREAT THE CALCOMP XXXXXX CASE                   **
34189C               **  (NOT DONE)                                      **
34190C               **  REFERENCE--XX                                   **
34191C               **             XX                                   **
34192C               **             PAGES XX AND XX                      **
34193C               ******************************************************
34194C
34195 4100 CONTINUE
34196      IF(ICASE.EQ.'REGI')THEN
34197        GOTO8000
34198      ELSEIF(ICASE.EQ.'MARK')THEN
34199        GOTO9000
34200      ELSEIF(ICASE.EQ.'TEXT')THEN
34201        GOTO9000
34202      ELSE
34203        JPATTT=0
34204        IF(IPATTT.EQ.'SOLI')JPATTT=0
34205        IF(IPATTT.EQ.'SO')JPATTT=0
34206        IF(IPATTT.EQ.'DOTT')JPATTT=2
34207        IF(IPATTT.EQ.'DOT')JPATTT=2
34208        IF(IPATTT.EQ.'DO')JPATTT=2
34209        IF(IPATTT.EQ.'DASH')JPATTT=1
34210        IF(IPATTT.EQ.'DA')JPATTT=1
34211        IF(IPATTT.EQ.'DA1')JPATTT=3
34212        IF(IPATTT.EQ.'DA2')JPATTT=4
34213        IF(IPATTT.EQ.'DA3')JPATTT=5
34214        IF(IPATTT.EQ.'DA4')JPATTT=6
34215        IF(IPATTT.EQ.'DA5')JPATTT=7
34216        IF(IPATTT.EQ.'BLAN')JPATTT=-1
34217        IF(IPATTT.EQ.'BL  ')JPATTT=-1
34218        IF(IPATTT.EQ.'NONE')JPATTT=-1
34219        IF(IPATTT.EQ.'NO  ')JPATTT=-1
34220        IF(IPATTT.EQ.'    ')JPATTT=-1
34221      ENDIF
34222C
34223C               ******************************************************
34224C               **  STEP 46--                                       **
34225C               **  TREAT THE LAHEY   XXXXXX CASE                   **
34226C               **  REFERENCE--Programmer's Reference, Revision C   **
34227C               **             Lahey Computer Systems, January, 1992**
34228C               **             PAGES 51 THRU 65                     **
34229C               ******************************************************
34230C
34231 4600 CONTINUE
34232      IF(ICASE.EQ.'REGI')THEN
34233        GOTO8000
34234      ELSEIF(ICASE.EQ.'MARK')THEN
34235        GOTO9000
34236      ELSEIF(ICASE.EQ.'TEXT')THEN
34237        GOTO9000
34238      ELSE
34239        JPATTT=0
34240        IF(IPATTT.EQ.'SOLI')JPATTT=0
34241        IF(IPATTT.EQ.'SO')JPATTT=0
34242        IF(IPATTT.EQ.'DOTT')JPATTT=2
34243        IF(IPATTT.EQ.'DOT')JPATTT=2
34244        IF(IPATTT.EQ.'DO')JPATTT=2
34245        IF(IPATTT.EQ.'DASH')JPATTT=1
34246        IF(IPATTT.EQ.'DA')JPATTT=1
34247        IF(IPATTT.EQ.'DA1')JPATTT=3
34248        IF(IPATTT.EQ.'DA2')JPATTT=4
34249        IF(IPATTT.EQ.'DA3')JPATTT=5
34250        IF(IPATTT.EQ.'DA4')JPATTT=6
34251        IF(IPATTT.EQ.'DA5')JPATTT=7
34252        IF(IPATTT.EQ.'BLAN')JPATTT=-1
34253        IF(IPATTT.EQ.'BL  ')JPATTT=-1
34254        IF(IPATTT.EQ.'NONE')JPATTT=-1
34255        IF(IPATTT.EQ.'NO  ')JPATTT=-1
34256        IF(IPATTT.EQ.'    ')JPATTT=-1
34257      ENDIF
34258      GOTO9000
34259C
34260C               ******************************************************
34261C               **  STEP 47--                                       **
34262C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
34263C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
34264C               ******************************************************
34265C
34266 4700 CONTINUE
34267      IF(ICASE.EQ.'REGI')THEN
34268        GOTO8000
34269      ELSEIF(ICASE.EQ.'MARK')THEN
34270        GOTO9000
34271      ELSEIF(ICASE.EQ.'TEXT')THEN
34272        GOTO9000
34273      ELSE
34274        JPATTT=0
34275        IF(IPATTT.EQ.'SOLI')JPATTT=1
34276        IF(IPATTT.EQ.'SO')JPATTT=1
34277        IF(IPATTT.EQ.'DOTT')JPATTT=2
34278        IF(IPATTT.EQ.'DOT')JPATTT=2
34279        IF(IPATTT.EQ.'DO')JPATTT=2
34280        IF(IPATTT.EQ.'DASH')JPATTT=3
34281        IF(IPATTT.EQ.'DA')JPATTT=3
34282        IF(IPATTT.EQ.'DA1')JPATTT=3
34283        IF(IPATTT.EQ.'DA2')JPATTT=4
34284        IF(IPATTT.EQ.'DA3')JPATTT=5
34285        IF(IPATTT.EQ.'DA4')JPATTT=6
34286        IF(IPATTT.EQ.'DA5')JPATTT=7
34287        IF(IPATTT.EQ.'BLAN')JPATTT=-1
34288        IF(IPATTT.EQ.'BL  ')JPATTT=-1
34289        IF(IPATTT.EQ.'NONE')JPATTT=-1
34290        IF(IPATTT.EQ.'NO  ')JPATTT=-1
34291        IF(IPATTT.EQ.'    ')JPATTT=-1
34292      ENDIF
34293      GOTO9000
34294C
34295C               ******************************************************
34296C               **  STEP 48--                                       **
34297C               **  TREAT THE OPEN-GL DRIVER                        **
34298C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
34299C               ******************************************************
34300C
34301 4800 CONTINUE
34302      IF(ICASE.EQ.'REGI')THEN
34303        GOTO8000
34304      ELSEIF(ICASE.EQ.'MARK')THEN
34305        GOTO9000
34306      ELSEIF(ICASE.EQ.'TEXT')THEN
34307        GOTO9000
34308      ELSE
34309        JPATTT=0
34310        IF(IPATTT.EQ.'SOLI')JPATTT=1
34311        IF(IPATTT.EQ.'SO')JPATTT=1
34312        IF(IPATTT.EQ.'DOTT')JPATTT=2
34313        IF(IPATTT.EQ.'DOT')JPATTT=2
34314        IF(IPATTT.EQ.'DO')JPATTT=2
34315        IF(IPATTT.EQ.'DASH')JPATTT=3
34316        IF(IPATTT.EQ.'DA')JPATTT=3
34317        IF(IPATTT.EQ.'DA1')JPATTT=3
34318        IF(IPATTT.EQ.'DA2')JPATTT=4
34319        IF(IPATTT.EQ.'DA3')JPATTT=5
34320        IF(IPATTT.EQ.'DA4')JPATTT=6
34321        IF(IPATTT.EQ.'DA5')JPATTT=7
34322        IF(IPATTT.EQ.'BLAN')JPATTT=-1
34323        IF(IPATTT.EQ.'BL  ')JPATTT=-1
34324        IF(IPATTT.EQ.'NONE')JPATTT=-1
34325        IF(IPATTT.EQ.'NO  ')JPATTT=-1
34326        IF(IPATTT.EQ.'    ')JPATTT=-1
34327      ENDIF
34328      GOTO9000
34329C
34330C               ******************************************************
34331C               **  STEP 49--                                       **
34332C               **  TREAT THE LAHEY INTERACTOR CASE                 **
34333C               ******************************************************
34334C
34335 4900 CONTINUE
34336      IF(ICASE.EQ.'REGI')THEN
34337        GOTO8000
34338      ELSEIF(ICASE.EQ.'MARK')THEN
34339        GOTO9000
34340      ELSEIF(ICASE.EQ.'TEXT')THEN
34341        GOTO9000
34342      ELSE
34343        GOTO9000
34344      ENDIF
34345      GOTO9000
34346C
34347C               ******************************************************
34348C               **  STEP 49B-                                       **
34349C               **  TREAT THE LAHEY WINTERACTOR CASE                **
34350C               ******************************************************
34351C
34352 4950 CONTINUE
34353      IF(ICASE.EQ.'REGI')THEN
34354        GOTO8000
34355      ELSEIF(ICASE.EQ.'MARK')THEN
34356        GOTO9000
34357      ELSEIF(ICASE.EQ.'TEXT')THEN
34358        GOTO9000
34359      ELSE
34360        JPATTT=0
34361        IF(IPATTT.EQ.'SOLI')JPATTT=0
34362        IF(IPATTT.EQ.'SO')JPATTT=0
34363        IF(IPATTT.EQ.'DOTT')JPATTT=1
34364        IF(IPATTT.EQ.'DOT')JPATTT=1
34365        IF(IPATTT.EQ.'DO')JPATTT=1
34366        IF(IPATTT.EQ.'DASH')JPATTT=2
34367        IF(IPATTT.EQ.'DA')JPATTT=2
34368        IF(IPATTT.EQ.'DA1')JPATTT=3
34369        IF(IPATTT.EQ.'DA2')JPATTT=4
34370        IF(IPATTT.EQ.'DA3')JPATTT=3
34371        IF(IPATTT.EQ.'DA4')JPATTT=4
34372        IF(IPATTT.EQ.'DA5')JPATTT=3
34373        IF(IPATTT.EQ.'BLAN')JPATTT=-1
34374        IF(IPATTT.EQ.'BL  ')JPATTT=-1
34375        IF(IPATTT.EQ.'NONE')JPATTT=-1
34376        IF(IPATTT.EQ.'NO  ')JPATTT=-1
34377        IF(IPATTT.EQ.'    ')JPATTT=-1
34378      ENDIF
34379      GOTO9000
34380C
34381C
34382C               ******************************************************
34383C               **  STEP 51--                                       **
34384C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
34385C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
34386C               **             MODELS 3600SX AND 3653SX             **
34387C               **             PAGES B-0 AND B-1                    **
34388C               **  USE ZETA EXTENSION TO STANDARD CALCOMP LIBRARY  **
34389C               **  ALTHOUGH USER CAN DEFINE THE DASH PATTERN, USE  **
34390C               **  THE 6 PRE-DEFINED DASH PATTERNS                 **
34391C               ******************************************************
34392C
34393 5100 CONTINUE
34394      IF(ICASE.EQ.'REGI')THEN
34395        GOTO8000
34396      ELSEIF(ICASE.EQ.'MARK')THEN
34397        GOTO9000
34398      ELSEIF(ICASE.EQ.'TEXT')THEN
34399        GOTO9000
34400      ELSE
34401        JPATTT=0
34402        IF(IPATTT.EQ.'SOLI')JPATTT=0
34403        IF(IPATTT.EQ.'SO')JPATTT=0
34404        IF(IPATTT.EQ.'DOTT')JPATTT=2
34405        IF(IPATTT.EQ.'DOT')JPATTT=2
34406        IF(IPATTT.EQ.'DO')JPATTT=2
34407        IF(IPATTT.EQ.'DASH')JPATTT=1
34408        IF(IPATTT.EQ.'DA')JPATTT=1
34409        IF(IPATTT.EQ.'DA1')JPATTT=3
34410        IF(IPATTT.EQ.'DA2')JPATTT=4
34411        IF(IPATTT.EQ.'DA3')JPATTT=5
34412        IF(IPATTT.EQ.'DA4')JPATTT=6
34413        IF(IPATTT.EQ.'DA5')JPATTT=1
34414        IF(IPATTT.EQ.'BLAN')JPATTT=-1
34415        IF(IPATTT.EQ.'BL  ')JPATTT=-1
34416        IF(IPATTT.EQ.'NONE')JPATTT=-1
34417        IF(IPATTT.EQ.'NO  ')JPATTT=-1
34418        IF(IPATTT.EQ.'    ')JPATTT=-1
34419      ENDIF
34420      GOTO9000
34421C
34422C
34423C               ******************************************************
34424C               **  STEP 66--                                       **
34425C               **  TREAT THE SUN       CASE                        **
34426C               ******************************************************
34427C
34428 6600 CONTINUE
34429      IF(ICASE.EQ.'REGI')THEN
34430        GOTO8000
34431      ELSEIF(ICASE.EQ.'MARK')THEN
34432        GOTO9000
34433      ELSEIF(ICASE.EQ.'TEXT')THEN
34434        GOTO9000
34435      ELSE
34436        JPATTT=0
34437        IF(IPATTT.EQ.'BLAN')JPATTT=-1
34438        IF(IPATTT.EQ.'BL  ')JPATTT=-1
34439        IF(IPATTT.EQ.'NONE')JPATTT=-1
34440        IF(IPATTT.EQ.'NO  ')JPATTT=-1
34441        IF(IPATTT.EQ.'    ')JPATTT=-1
34442        IF(IPATTT.EQ.'SOLI')JPATTT=0
34443        IF(IPATTT.EQ.'SO  ')JPATTT=0
34444        IF(IPATTT.EQ.'DOTT')JPATTT=1
34445        IF(IPATTT.EQ.'DOT ')JPATTT=1
34446        IF(IPATTT.EQ.'DO  ')JPATTT=1
34447        IF(IPATTT.EQ.'DASH')JPATTT=2
34448        IF(IPATTT.EQ.'DA  ')JPATTT=2
34449        IF(IPATTT.EQ.'DA1 ')JPATTT=3
34450        IF(IPATTT.EQ.'DA2 ')JPATTT=4
34451        IF(IPATTT.EQ.'DA3 ')JPATTT=5
34452      ENDIF
34453      GOTO9000
34454C
34455C
34456C               ******************************************************
34457C               **  STEP 81--                                       **
34458C               **  TREAT THE REGIS     CASE                        **
34459C               ******************************************************
34460C
34461 8100 CONTINUE
34462      IF(ICASE.EQ.'REGI')THEN
34463        GOTO8000
34464      ELSEIF(ICASE.EQ.'MARK')THEN
34465        GOTO9000
34466      ELSEIF(ICASE.EQ.'TEXT')THEN
34467        GOTO9000
34468      ELSE
34469        JPATTT=1
34470        IF(IPATTT.EQ.'BLAN')JPATTT=0
34471        IF(IPATTT.EQ.'BL  ')JPATTT=0
34472        IF(IPATTT.EQ.'NONE')JPATTT=0
34473        IF(IPATTT.EQ.'NO  ')JPATTT=0
34474        IF(IPATTT.EQ.'    ')JPATTT=0
34475        IF(IPATTT.EQ.'SOLI')JPATTT=1
34476        IF(IPATTT.EQ.'SO')JPATTT=1
34477        IF(IPATTT.EQ.'DOTT')JPATTT=4
34478        IF(IPATTT.EQ.'DOT')JPATTT=4
34479        IF(IPATTT.EQ.'DO')JPATTT=4
34480        IF(IPATTT.EQ.'DASH')JPATTT=2
34481        IF(IPATTT.EQ.'DA')JPATTT=2
34482        IF(IPATTT.EQ.'DA1')JPATTT=3
34483        IF(IPATTT.EQ.'DA2')JPATTT=5
34484        IF(IPATTT.EQ.'DA3')JPATTT=6
34485        IF(IPATTT.EQ.'DA4')JPATTT=6
34486        IF(IPATTT.EQ.'DA5')JPATTT=6
34487      ENDIF
34488      GOTO9000
34489C
34490C
34491C               ******************************************************
34492C               **  STEP 86--                                       **
34493C               **  TREAT THE POSTSCRIPT CASE                       **
34494C               ******************************************************
34495C
34496 8600 CONTINUE
34497      IF(ICASE.EQ.'REGI')THEN
34498        GOTO8000
34499      ELSEIF(ICASE.EQ.'MARK')THEN
34500        GOTO9000
34501      ELSEIF(ICASE.EQ.'TEXT')THEN
34502        GOTO9000
34503      ELSE
34504        JPATTT=1
34505        IF(IPATTT.EQ.'BLAN')JPATTT=0
34506        IF(IPATTT.EQ.'BL  ')JPATTT=0
34507        IF(IPATTT.EQ.'NONE')JPATTT=0
34508        IF(IPATTT.EQ.'NO  ')JPATTT=0
34509        IF(IPATTT.EQ.'    ')JPATTT=0
34510        IF(IPATTT.EQ.'SOLI')JPATTT=1
34511        IF(IPATTT.EQ.'SO')JPATTT=1
34512        IF(IPATTT.EQ.'DOTT')JPATTT=2
34513        IF(IPATTT.EQ.'DOT')JPATTT=2
34514        IF(IPATTT.EQ.'DO')JPATTT=2
34515        IF(IPATTT.EQ.'DASH')JPATTT=3
34516        IF(IPATTT.EQ.'DA')JPATTT=3
34517        IF(IPATTT.EQ.'DA1')JPATTT=4
34518        IF(IPATTT.EQ.'DA2')JPATTT=5
34519        IF(IPATTT.EQ.'DA3')JPATTT=6
34520        IF(IPATTT.EQ.'DA4')JPATTT=7
34521        IF(IPATTT.EQ.'DA5')JPATTT=7
34522      ENDIF
34523      GOTO9000
34524C
34525C               ******************************************************
34526C               **  STEP 91--                                       **
34527C               **  TREAT THE QUIC      CASE                        **
34528C               **  USE THE PREDEFINED PATTERNS                     **
34529C               **  REFERENCE--QUIC PROGRAMMING MANUAL FROM QMS     **
34530C               **  P 14-7                                          **
34531C               ******************************************************
34532C
34533 9100 CONTINUE
34534      IF(ICASE.EQ.'REGI')THEN
34535        CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
34536C
34537C       LINE WILL BE 3 PIXELS WIDE.  BASE SPACING FOR SOLID FILL ON
34538C       NUMBER OF HORIZONTAL PICTURE POINTS.
34539C
34540        PXSPA2=PXSPA
34541        PYSPA2=PYSPA
34542        IF(IPATTT.EQ.'SOLI')PXSPA2=100.*(3./ANUMHP)
34543        IF(IPATTT.EQ.'SOLI')PYSPA2=100.*(3./ANUMVP)
34544        IF(IPATTT.EQ.'FILL')PXSPA2=100.*(3./ANUMHP)
34545        IF(IPATTT.EQ.'FILL')PYSPA2=100.*(3./ANUMVP)
34546      ELSEIF(ICASE.EQ.'MARK')THEN
34547        GOTO9000
34548      ELSEIF(ICASE.EQ.'TEXT')THEN
34549        GOTO9000
34550      ELSE
34551        JPATTT=0
34552        IF(IPATTT.EQ.'SOLI')JPATTT=0
34553        IF(IPATTT.EQ.'SO')JPATTT=0
34554        IF(IPATTT.EQ.'DOTT')JPATTT=2
34555        IF(IPATTT.EQ.'DOT')JPATTT=2
34556        IF(IPATTT.EQ.'DO')JPATTT=2
34557        IF(IPATTT.EQ.'DASH')JPATTT=1
34558        IF(IPATTT.EQ.'DA')JPATTT=1
34559        IF(IPATTT.EQ.'DA1')JPATTT=3
34560        IF(IPATTT.EQ.'DA2')JPATTT=4
34561        IF(IPATTT.EQ.'DA3')JPATTT=5
34562        IF(IPATTT.EQ.'DA4')JPATTT=6
34563        IF(IPATTT.EQ.'DA5')JPATTT=7
34564        IF(IPATTT.EQ.'BLAN')JPATTT=-1
34565        IF(IPATTT.EQ.'BL  ')JPATTT=-1
34566        IF(IPATTT.EQ.'NONE')JPATTT=-1
34567        IF(IPATTT.EQ.'NO  ')JPATTT=-1
34568        IF(IPATTT.EQ.'    ')JPATTT=-1
34569      ENDIF
34570      GOTO9000
34571C
34572C               ******************************************************
34573C               **  STEP 96--                                       **
34574C               **  TREAT THE X11       CASE                        **
34575C               **  NOTE THAT FOR LINE PATTERNS, A SOLID, DASH, DOT,**
34576C               **  AND DASH-DOT PATTERNS ARE DEFINED IN THE C      **
34577C               **  LIBRARY.  CURRENTLY, DASH1-DASH5 ALL SET THE SAME*
34578C               **  DASH-DOT PATTERN.  HOWEVER, THE NUMBER OF DASH  **
34579C               **  PATTERNS MAY BE INCREASED IN THE FUTURE (THE    **
34580C               **  CAN DEFINE ARBITRARY DASH PATTERNS).            **
34581C               **  X11 DOES NOT DEFINE ANY HATCH PATTERNS.  IT DOES**
34582C               **  ALLOW PRE-BUILT BIT ARRAYS (USUALLY 8X8 OR 16X16**
34583C               **  PIXELS) TO FILL REGIONS WITH PATTERNS.  HOWEVER,**
34584C               **  THIS IS NOT CONSISTENT WITH HOW DATAPLOT DEFINES**
34585C               **  PATTERNS, SO LET DATAPLOT DO REGION FILLS IN    **
34586C               **  SOFTWARE.                                       **
34587C               ******************************************************
34588C
34589 9600 CONTINUE
34590      IF(ICASE.EQ.'REGI')THEN
34591        GOTO8000
34592      ELSEIF(ICASE.EQ.'MARK')THEN
34593        GOTO9000
34594      ELSEIF(ICASE.EQ.'TEXT')THEN
34595        GOTO9000
34596      ELSE
34597        JPATTT=0
34598        IF(IPATTT.EQ.'SOLI')JPATTT=0
34599        IF(IPATTT.EQ.'SO')JPATTT=0
34600        IF(IPATTT.EQ.'DOTT')JPATTT=2
34601        IF(IPATTT.EQ.'DOT')JPATTT=2
34602        IF(IPATTT.EQ.'DO')JPATTT=2
34603        IF(IPATTT.EQ.'DASH')JPATTT=1
34604        IF(IPATTT.EQ.'DA')JPATTT=1
34605        IF(IPATTT.EQ.'DA1')JPATTT=3
34606        IF(IPATTT.EQ.'DA2')JPATTT=4
34607        IF(IPATTT.EQ.'DA3')JPATTT=5
34608        IF(IPATTT.EQ.'DA4')JPATTT=6
34609        IF(IPATTT.EQ.'DA5')JPATTT=7
34610        IF(IPATTT.EQ.'BLAN')JPATTT=-1
34611        IF(IPATTT.EQ.'BL  ')JPATTT=-1
34612        IF(IPATTT.EQ.'NONE')JPATTT=-1
34613        IF(IPATTT.EQ.'NO  ')JPATTT=-1
34614        IF(IPATTT.EQ.'    ')JPATTT=-1
34615      ENDIF
34616      GOTO9000
34617C
34618C               *************************************************
34619C               **  STEP 100--                                 **
34620C               **  TREAT THE VGA VIA TURBO-C       CASE       **
34621C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
34622C               **             ENHANCEMENTS, PAGE 83.          **
34623C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
34624C               **             PAGE 320.                       **
34625C               **  REFERENCE--WEISKAMP, POWER GRAPHICS        **
34626C               **             USING TURBO C, PAGE 29.         **
34627C               *************************************************
34628C
3462910000 CONTINUE
34630      IF(ICASE.EQ.'REGI')THEN
34631        GOTO8000
34632      ELSEIF(ICASE.EQ.'MARK')THEN
34633        GOTO9000
34634      ELSEIF(ICASE.EQ.'TEXT')THEN
34635        GOTO9000
34636      ELSE
34637        JPATTT=0
34638        IF(IPATTT.EQ.'SOLI')JPATTT=0
34639        IF(IPATTT.EQ.'SO')JPATTT=0
34640        IF(IPATTT.EQ.'DOTT')JPATTT=1
34641        IF(IPATTT.EQ.'DOT')JPATTT=1
34642        IF(IPATTT.EQ.'DO')JPATTT=1
34643        IF(IPATTT.EQ.'DASH')JPATTT=3
34644        IF(IPATTT.EQ.'DA')JPATTT=3
34645        IF(IPATTT.EQ.'DA1')JPATTT=2
34646        IF(IPATTT.EQ.'DA2')JPATTT=2
34647        IF(IPATTT.EQ.'DA3')JPATTT=2
34648        IF(IPATTT.EQ.'DA4')JPATTT=2
34649        IF(IPATTT.EQ.'DA5')JPATTT=2
34650        IF(IPATTT.EQ.'BLAN')JPATTT=-1
34651        IF(IPATTT.EQ.'BL  ')JPATTT=-1
34652        IF(IPATTT.EQ.'NONE')JPATTT=-1
34653        IF(IPATTT.EQ.'NO  ')JPATTT=-1
34654        IF(IPATTT.EQ.'    ')JPATTT=-1
34655      ENDIF
34656      GOTO9000
34657C
34658C               ******************************************************
34659C               **  STEP 110--                                      **
34660C               **  TREAT THE GKS                DRIVER             **
34661C               ******************************************************
34662C
3466311000 CONTINUE
34664      IF(ICASE.EQ.'REGI')THEN
34665        GOTO8000
34666      ELSEIF(ICASE.EQ.'MARK')THEN
34667        GOTO9000
34668      ELSEIF(ICASE.EQ.'TEXT')THEN
34669        GOTO9000
34670      ELSE
34671        JPATTT=0
34672        IF(IPATTT.EQ.'SOLI')JPATTT=1
34673        IF(IPATTT.EQ.'SO')JPATTT=1
34674        IF(IPATTT.EQ.'DOTT')JPATTT=3
34675        IF(IPATTT.EQ.'DOT')JPATTT=3
34676        IF(IPATTT.EQ.'DO')JPATTT=3
34677        IF(IPATTT.EQ.'DASH')JPATTT=2
34678        IF(IPATTT.EQ.'DA')JPATTT=2
34679        IF(IPATTT.EQ.'DA1')JPATTT=2
34680        IF(IPATTT.EQ.'DA2')JPATTT=4
34681        IF(IPATTT.EQ.'DA3')JPATTT=5
34682        IF(IPATTT.EQ.'DA4')JPATTT=6
34683        IF(IPATTT.EQ.'DA5')JPATTT=7
34684        IF(IPATTT.EQ.'BLAN')JPATTT=-1
34685        IF(IPATTT.EQ.'BL  ')JPATTT=-1
34686        IF(IPATTT.EQ.'NONE')JPATTT=-1
34687        IF(IPATTT.EQ.'NO  ')JPATTT=-1
34688        IF(IPATTT.EQ.'    ')JPATTT=-1
34689      ENDIF
34690      GOTO9000
34691C
34692C               ******************************************************
34693C               **  STEP 120--                                      **
34694C               **  TREAT THE GD                     DRIVER         **
34695C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
34696C               **  1) JPEG                                         **
34697C               **  2) PNG                                          **
34698C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
34699C               ******************************************************
34700C
3470112000 CONTINUE
34702      IF(ICASE.EQ.'REGI')THEN
34703        GOTO8000
34704      ELSEIF(ICASE.EQ.'MARK')THEN
34705        GOTO9000
34706      ELSEIF(ICASE.EQ.'TEXT')THEN
34707        GOTO9000
34708      ELSE
34709        JPATTT=0
34710        IF(IPATTT.EQ.'SOLI')JPATTT=1
34711        IF(IPATTT.EQ.'SO')JPATTT=1
34712        IF(IPATTT.EQ.'DOTT')JPATTT=3
34713        IF(IPATTT.EQ.'DOT')JPATTT=3
34714        IF(IPATTT.EQ.'DO')JPATTT=3
34715        IF(IPATTT.EQ.'DASH')JPATTT=2
34716        IF(IPATTT.EQ.'DA')JPATTT=2
34717        IF(IPATTT.EQ.'DA1')JPATTT=2
34718        IF(IPATTT.EQ.'DA2')JPATTT=4
34719        IF(IPATTT.EQ.'DA3')JPATTT=5
34720        IF(IPATTT.EQ.'DA4')JPATTT=6
34721        IF(IPATTT.EQ.'DA5')JPATTT=7
34722        IF(IPATTT.EQ.'BLAN')JPATTT=-1
34723        IF(IPATTT.EQ.'BL  ')JPATTT=-1
34724        IF(IPATTT.EQ.'NONE')JPATTT=-1
34725        IF(IPATTT.EQ.'NO  ')JPATTT=-1
34726        IF(IPATTT.EQ.'    ')JPATTT=-1
34727      ENDIF
34728      GOTO9000
34729C
34730C               ******************************************************
34731C               **  STEP 130--                                      **
34732C               **  TREAT THE ABSOFT                 DRIVER         **
34733C               ******************************************************
34734C
3473513000 CONTINUE
34736      IF(ICASE.EQ.'REGI')THEN
34737        GOTO8000
34738      ELSEIF(ICASE.EQ.'MARK')THEN
34739        GOTO9000
34740      ELSEIF(ICASE.EQ.'TEXT')THEN
34741        GOTO9000
34742      ELSE
34743        JPATTT=0
34744        IF(IPATTT.EQ.'SOLI')JPATTT=1
34745        IF(IPATTT.EQ.'SO')JPATTT=1
34746        IF(IPATTT.EQ.'DOTT')JPATTT=3
34747        IF(IPATTT.EQ.'DOT')JPATTT=3
34748        IF(IPATTT.EQ.'DO')JPATTT=3
34749        IF(IPATTT.EQ.'DASH')JPATTT=2
34750        IF(IPATTT.EQ.'DA')JPATTT=2
34751        IF(IPATTT.EQ.'DA1')JPATTT=2
34752        IF(IPATTT.EQ.'DA2')JPATTT=4
34753        IF(IPATTT.EQ.'DA3')JPATTT=5
34754        IF(IPATTT.EQ.'DA4')JPATTT=6
34755        IF(IPATTT.EQ.'DA5')JPATTT=7
34756        IF(IPATTT.EQ.'BLAN')JPATTT=-1
34757        IF(IPATTT.EQ.'BL  ')JPATTT=-1
34758        IF(IPATTT.EQ.'NONE')JPATTT=-1
34759        IF(IPATTT.EQ.'NO  ')JPATTT=-1
34760        IF(IPATTT.EQ.'    ')JPATTT=-1
34761      ENDIF
34762      GOTO9000
34763C
34764C               ******************************************************
34765C               **  STEP 135--                                      **
34766C               **  TREAT THE AQUA                   DRIVER         **
34767C               ******************************************************
34768C
3476913500 CONTINUE
34770      IF(ICASE.EQ.'REGI')THEN
34771        GOTO8000
34772      ELSEIF(ICASE.EQ.'MARK')THEN
34773        GOTO9000
34774      ELSEIF(ICASE.EQ.'TEXT')THEN
34775        GOTO9000
34776      ELSE
34777        JPATTT=0
34778        IF(IPATTT.EQ.'SOLI')JPATTT=1
34779        IF(IPATTT.EQ.'SO')JPATTT=1
34780        IF(IPATTT.EQ.'DOTT')JPATTT=3
34781        IF(IPATTT.EQ.'DOT')JPATTT=3
34782        IF(IPATTT.EQ.'DO')JPATTT=3
34783        IF(IPATTT.EQ.'DASH')JPATTT=2
34784        IF(IPATTT.EQ.'DA')JPATTT=2
34785        IF(IPATTT.EQ.'DA1')JPATTT=2
34786        IF(IPATTT.EQ.'DA2')JPATTT=4
34787        IF(IPATTT.EQ.'DA3')JPATTT=5
34788        IF(IPATTT.EQ.'DA4')JPATTT=6
34789        IF(IPATTT.EQ.'DA5')JPATTT=7
34790        IF(IPATTT.EQ.'BLAN')JPATTT=-1
34791        IF(IPATTT.EQ.'BL  ')JPATTT=-1
34792        IF(IPATTT.EQ.'NONE')JPATTT=-1
34793        IF(IPATTT.EQ.'NO  ')JPATTT=-1
34794        IF(IPATTT.EQ.'    ')JPATTT=-1
34795      ENDIF
34796      GOTO9000
34797C
34798C               ******************************************************
34799C               **  STEP 150--                                      **
34800C               **  TREAT THE LATEX (USING EEPIC)            DRIVER **
34801C               ******************************************************
3480215000 CONTINUE
34803      IF(ICASE.EQ.'REGI')THEN
34804        GOTO8000
34805      ELSEIF(ICASE.EQ.'MARK')THEN
34806        GOTO9000
34807      ELSEIF(ICASE.EQ.'TEXT')THEN
34808        GOTO9000
34809      ELSE
34810        JPATTT=0
34811        IF(IPATTT.EQ.'SOLI')JPATTT=1
34812        IF(IPATTT.EQ.'SO')JPATTT=1
34813        IF(IPATTT.EQ.'DOTT')JPATTT=3
34814        IF(IPATTT.EQ.'DOT')JPATTT=3
34815        IF(IPATTT.EQ.'DO')JPATTT=3
34816        IF(IPATTT.EQ.'DASH')JPATTT=2
34817        IF(IPATTT.EQ.'DA')JPATTT=2
34818        IF(IPATTT.EQ.'DA1')JPATTT=2
34819        IF(IPATTT.EQ.'DA2')JPATTT=4
34820        IF(IPATTT.EQ.'DA3')JPATTT=5
34821        IF(IPATTT.EQ.'DA4')JPATTT=6
34822        IF(IPATTT.EQ.'DA5')JPATTT=7
34823        IF(IPATTT.EQ.'BLAN')JPATTT=-1
34824        IF(IPATTT.EQ.'BL  ')JPATTT=-1
34825        IF(IPATTT.EQ.'NONE')JPATTT=-1
34826        IF(IPATTT.EQ.'NO  ')JPATTT=-1
34827        IF(IPATTT.EQ.'    ')JPATTT=-1
34828      ENDIF
34829      GOTO9000
34830C
34831C               ******************************************************
34832C               **  STEP 160--                                      **
34833C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
34834C               ******************************************************
34835C
3483616000 CONTINUE
34837      IF(ICASE.EQ.'REGI')THEN
34838        GOTO8000
34839      ELSEIF(ICASE.EQ.'MARK')THEN
34840        GOTO9000
34841      ELSEIF(ICASE.EQ.'TEXT')THEN
34842        GOTO9000
34843      ELSE
34844        JPATTT=0
34845        IF(IPATTT.EQ.'SOLI')JPATTT=1
34846        IF(IPATTT.EQ.'SO')JPATTT=1
34847        IF(IPATTT.EQ.'DOTT')JPATTT=3
34848        IF(IPATTT.EQ.'DOT')JPATTT=3
34849        IF(IPATTT.EQ.'DO')JPATTT=3
34850        IF(IPATTT.EQ.'DASH')JPATTT=2
34851        IF(IPATTT.EQ.'DA')JPATTT=2
34852        IF(IPATTT.EQ.'DA1')JPATTT=4
34853        IF(IPATTT.EQ.'DA2')JPATTT=5
34854        IF(IPATTT.EQ.'DA3')JPATTT=6
34855        IF(IPATTT.EQ.'DA4')JPATTT=7
34856        IF(IPATTT.EQ.'DA5')JPATTT=8
34857        IF(IPATTT.EQ.'BLAN')JPATTT=-1
34858        IF(IPATTT.EQ.'BL  ')JPATTT=-1
34859        IF(IPATTT.EQ.'NONE')JPATTT=-1
34860        IF(IPATTT.EQ.'NO  ')JPATTT=-1
34861        IF(IPATTT.EQ.'    ')JPATTT=-1
34862      ENDIF
34863      GOTO9000
34864C
34865C               ******************************************************
34866C               **  STEP 170--                                      **
34867C               **  TREAT THE CAIRO                          DRIVER **
34868C               ******************************************************
34869C
3487017000 CONTINUE
34871      IF(ICASE.EQ.'REGI')THEN
34872        GOTO8000
34873      ELSEIF(ICASE.EQ.'MARK')THEN
34874        GOTO9000
34875      ELSEIF(ICASE.EQ.'TEXT')THEN
34876        GOTO9000
34877      ELSE
34878        JPATTT=0
34879        IF(IPATTT.EQ.'SOLI')JPATTT=1
34880        IF(IPATTT.EQ.'SO')JPATTT=1
34881        IF(IPATTT.EQ.'DOTT')JPATTT=3
34882        IF(IPATTT.EQ.'DOT')JPATTT=3
34883        IF(IPATTT.EQ.'DO')JPATTT=3
34884        IF(IPATTT.EQ.'DASH')JPATTT=2
34885        IF(IPATTT.EQ.'DA')JPATTT=2
34886        IF(IPATTT.EQ.'DA1')JPATTT=4
34887        IF(IPATTT.EQ.'DA2')JPATTT=5
34888        IF(IPATTT.EQ.'DA3')JPATTT=6
34889        IF(IPATTT.EQ.'DA4')JPATTT=7
34890        IF(IPATTT.EQ.'DA5')JPATTT=8
34891        IF(IPATTT.EQ.'BLAN')JPATTT=-1
34892        IF(IPATTT.EQ.'BL  ')JPATTT=-1
34893        IF(IPATTT.EQ.'NONE')JPATTT=-1
34894        IF(IPATTT.EQ.'NO  ')JPATTT=-1
34895        IF(IPATTT.EQ.'    ')JPATTT=-1
34896        GOTO9000
34897      ENDIF
34898      GOTO9000
34899C
34900C               ******************************************************
34901C               **  STEP 180--                                      **
34902C               **  TREAT THE WMF                            DRIVER **
34903C               ******************************************************
34904C
3490518000 CONTINUE
34906      IF(ICASE.EQ.'REGI')THEN
34907        GOTO8000
34908      ELSEIF(ICASE.EQ.'MARK')THEN
34909        GOTO9000
34910      ELSEIF(ICASE.EQ.'TEXT')THEN
34911        GOTO9000
34912      ELSE
34913        GOTO9000
34914      ENDIF
34915      GOTO9000
34916C
34917C               ******************************************************
34918C               **  STEP 190--                                      **
34919C               **  TREAT THE D3                             DRIVER **
34920C               ******************************************************
34921C
3492219000 CONTINUE
34923      IF(ICASE.EQ.'REGI')THEN
34924        GOTO8000
34925      ELSEIF(ICASE.EQ.'MARK')THEN
34926        GOTO9000
34927      ELSEIF(ICASE.EQ.'TEXT')THEN
34928        GOTO9000
34929      ELSE
34930        GOTO9000
34931      ENDIF
34932      GOTO9000
34933C
34934 8000 CONTINUE
34935      CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
34936      PXSPA2=PXSPA
34937      PYSPA2=PYSPA
34938      IF(IPATTT.EQ.'SOLI')PXSPA2=0.1
34939      IF(IPATTT.EQ.'SOLI')PYSPA2=0.1
34940      IF(IPATTT.EQ.'FILL')PXSPA2=0.1
34941      IF(IPATTT.EQ.'FILL')PYSPA2=0.1
34942      GOTO9000
34943C
34944C
34945C               *****************
34946C               **  STEP 90--  **
34947C               **  EXIT       **
34948C               *****************
34949C
34950 9000 CONTINUE
34951      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRPA')THEN
34952        WRITE(ICOUT,999)
34953        CALL DPWRST('XXX','BUG ')
34954        WRITE(ICOUT,9011)
34955 9011   FORMAT('***** AT THE END       OF GRTRPA--')
34956        CALL DPWRST('XXX','BUG ')
34957        WRITE(ICOUT,9014)PXSPA,PYSPA,PXSPA2,PYSPA2
34958 9014   FORMAT('PXSPA,PYSPA,PXSPA2,PYSPA2 = ',4G15.7)
34959        CALL DPWRST('XXX','BUG ')
34960        WRITE(ICOUT,9015)IHORPA,IVERPA,IDUPPA,IDDOPA
34961 9015   FORMAT('IHORPA,IVERPA,IDUPPA,IDDOPA = ',3(A4,2X),A4)
34962        CALL DPWRST('XXX','BUG ')
34963        WRITE(ICOUT,9019)IERRG4
34964 9019   FORMAT('IERRG4 = ',A4)
34965        CALL DPWRST('XXX','BUG ')
34966      ENDIF
34967C
34968      RETURN
34969      END
34970      SUBROUTINE GRTRSI(ICASE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP,
34971     1                  JSIZE,JHEIG2,JWIDT2,JVEGA2,JHOGA2,
34972     1                  PHEIG2,PWIDT2,PVEGA2,PHOGA2)
34973C
34974C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, TRANSLATE A DESIRED
34975C              SIZE (E.G., A CHARACTER SIZE) (HEIGHT, WIDTH, VERTICAL
34976C              GAP, HORIZONTAL GAP9 GIVEN IN (0.0 TO 100.0)
34977C              REPRESENTATION INTO AN INTEGER NUMERIC REPRESENTATION (IN
34978C              JSIZE) THAT WILL BE UNDERSTOOD BY THE TEKTRONIX GRAPHICS
34979C              DEVICE BEING USED.  ALSO, CREATE OTHER VARIABLES WHICH
34980C              CONTAIN THE CLOSEST ALLOWABLE SIZES (IN 0.0 TO 100.0
34981C              UNITS) THAT IS PERMITTED ON THE TEKTRONIX GRAPHICS DEVICE
34982C              BEING USED.
34983C
34984C     NOTE--PHEIGH IS IN RAW 0 TO 100 UNITS.
34985C           PHEIG2 IS ALSO IN 0 TO 100 UNITS BUT IS SCALED DOWN
34986C           TO REFLECT A SMALLER WINDOW (IF ONE EXISTS).
34987C           EXAMPLE--IF PHEIGH=3.0 AND WINDOW IS FROM Y = 0 TO Y = 50,
34988C                    THEN PHEIG2=1.5
34989C
34990C     NOTE--THE ONLY VARIABLES IN THE    PLOT CONTROL COMMON
34991C           THAT ARE USED HEREIN ARE THE ONES IN /RWIND/
34992C
34993C     WRITTEN BY--JAMES J. FILLIBEN
34994C                 STATISTICAL ENGINEERING DIVISION
34995C                 INFORMATION TECHNOLOGY LABORATORY
34996C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
34997C                 GAITHERSBURG, MD 20899-8980
34998C                 PVONE--301-975-2855
34999C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
35000C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
35001C     LANGUAGE--ANSI FORTRAN (1977)
35002C     VERSION NUMBER--83.6
35003C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
35004C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
35005C                                      DRIVER OBSOLETE
35006C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
35007C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
35008C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
35009C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
35010C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
35011C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
35012C     UPDATED         --MARCH    1991. REGIS FIX (BY ALAN HECKERT)
35013C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
35014C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
35015C                                      DRIVER OBSOLETE
35016C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
35017C                                      OLD, CALCOMP STYLE
35018C                                      DRIVER OBSOLETE
35019C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
35020C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
35021C                                      USE BILL MITCHELLS OPENGL
35022C                                      BINDING FOR FORTRAN
35023C     UPDATED         --OCTOBER  1996. GKS (ALAN)
35024C                                      CODED, NOT TESTED
35025C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
35026C                                      PLACEHOLDER FOR NOW
35027C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
35028C                                      PLACEHOLDER FOR NOW
35029C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
35030C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
35031C     UPDATED         --SEPTEMBER1998. MULTIPLOT SCALE FACTOR
35032C     UPDATED         --AUGUST   1999. BUG FIX FOR MULTIPLOT SCALE
35033C                                      FACTOR
35034C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
35035C     UPDATED         --JUNE     2000. MACINTOSH
35036C                                      PLACEHOLDER FOR NOW
35037C     UPDATED         --JUNE     2000. PC PRINTER
35038C                                      PLACEHOLDER FOR NOW
35039C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
35040C                                      PLACEHOLDER FOR NOW
35041C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
35042C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
35043C     UPDATED         --FEBRUARY 2006. IMPLEMENT LATEX DRIVER
35044C     UPDATED         --APRIL    2009. IMPLEMENT LIBPLOT DRIVER
35045C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
35046C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
35047C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
35048C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
35049C                                      GRAPHICS DEVICES
35050C     UPDATED         --DECEMBER 2018. SUPPORT  DEVICE <1/2/3> SCALE
35051C
35052C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
35053C
35054      CHARACTER*4 ICASE
35055      CHARACTER*4 IFONT
35056C
35057C-----COMMON----------------------------------------------------------
35058C
35059      INCLUDE 'DPCOPA.INC'
35060      INCLUDE 'DPCOPC.INC'
35061      INCLUDE 'DPCOGR.INC'
35062      INCLUDE 'DPCOBE.INC'
35063      INCLUDE 'DPCODV.INC'
35064      INCLUDE 'DPCOST.INC'
35065      INCLUDE 'DPCOP2.INC'
35066C
35067C-----START POINT-----------------------------------------------------
35068C
35069      IERRG4='NO'
35070C
35071      PHEIPP=(-999.0)
35072      PWIDPP=(-999.0)
35073      PVEGPP=(-999.0)
35074      PHOGPP=(-999.0)
35075C
35076      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRSI')THEN
35077        WRITE(ICOUT,999)
35078  999   FORMAT(1X)
35079        CALL DPWRST('XXX','BUG ')
35080        WRITE(ICOUT,51)
35081   51   FORMAT('***** AT THE BEGINNING OF GRTRSI--')
35082        CALL DPWRST('XXX','BUG ')
35083        WRITE(ICOUT,52)ICASE,IFONT,IMANUF,IMODEL,IBUGG4
35084   52   FORMAT('ICASE,IFONT,IMANUF,IMODEL,IBUGG4 = ',4(A4,2X),A4)
35085        CALL DPWRST('XXX','BUG ')
35086        WRITE(ICOUT,53)PHEIGH,PWIDTH,PVEGAP,PHOGAP
35087   53   FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4G15.7)
35088        CALL DPWRST('XXX','BUG ')
35089      ENDIF
35090C
35091CCCCC AUGMENT FOLLOWING LINES TO SUPPORT MULTIPLOT SCALE FACTOR
35092      AFACTH=1.0
35093      AFACTW=1.0
35094      IF(IMPSW2.EQ.'ON'.AND.IFONT.EQ.'TEKT')THEN
35095        AFACTH=AMPSCH
35096        AFACTW=AMPSCW
35097      ELSEIF(IEMBSW.EQ.'ON'.AND.IEMCNT.GT.1.AND.
35098     1       IFONT.EQ.'TEKT')THEN
35099        AFACTH=AMPSCH
35100        AFACTW=AMPSCW
35101      ENDIF
35102C
35103CCCCC ADD ADJUSTMENT FACTOR FROM "DEVICE ... SCALE" COMMAND
35104C
35105      AFACTH=AFACTH*PCHSCA
35106      AFACTW=AFACTW*PCHSCA
35107C
35108CCCCC DON'T ADJUST PHEIGH, ETC., ADJUST PHEIG2, ETC.   AUGUST 1999
35109C
35110      PHEIG2=(AFACTH*PHEIGH)*(PWYMAX-PWYMIN)/100.0
35111      PVEGA2=(AFACTH*PVEGAP)*(PWYMAX-PWYMIN)/100.0
35112      PWIDT2=(AFACTW*PWIDTH)*(PWXMAX-PWXMIN)/100.0
35113      PHOGA2=(AFACTW*PHOGAP)*(PWXMAX-PWXMIN)/100.0
35114C
35115      RATIVH=ANUMVP/ANUMHP
35116      RATIV1=ANUMVP/100.0
35117      IF(IFONT.NE.'TEKT')GOTO9000
35118C
35119C               ********************************************
35120C               **  STEP 1--                              **
35121C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
35122C               **  AND THE MODEL                         **
35123C               ********************************************
35124C
35125      IF(IMANUF.EQ.'QWIN')THEN
35126        GOTO4700
35127      ELSEIF(IMANUF.EQ.'POST')THEN
35128        GOTO8600
35129      ELSEIF(IMANUF.EQ.'X11 ')THEN
35130        GOTO9600
35131      ELSEIF(IMANUF.EQ.'AQUA')THEN
35132        GOTO13500
35133      ELSEIF(IMANUF.EQ.'GENE')THEN
35134        IF(IMODEL.EQ.'CODE')GOTO3200
35135        IF(IMODEL.EQ.'CGM')GOTO3300
35136        IF(IMODEL.EQ.'CGMB')GOTO3400
35137        GOTO3100
35138      ELSEIF(IMANUF.EQ.'SVG ')THEN
35139        GOTO16000
35140      ELSEIF(IMANUF.EQ.'GD  ')THEN
35141        GOTO12000
35142      ELSEIF(IMANUF.EQ.'LATE')THEN
35143        GOTO15000
35144      ELSEIF(IMANUF.EQ.'CAIR')THEN
35145        GOTO17000
35146      ELSEIF(IMANUF.EQ.'D3  ')THEN
35147        GOTO19000
35148      ELSEIF(IMANUF.EQ.'WMF ')THEN
35149        GOTO18000
35150      ELSEIF(IMANUF.EQ.'OPGL')THEN
35151        GOTO4800
35152      ELSEIF(IMANUF.EQ.'TEKT')THEN
35153        IF(IMODEL.EQ.'4006')GOTO1100
35154        IF(IMODEL.EQ.'4010')GOTO1100
35155        IF(IMODEL.EQ.'4050')GOTO1100
35156        IF(IMODEL.EQ.'4052')GOTO1100
35157C
35158        IF(IMODEL.EQ.'4012')GOTO1200
35159        IF(IMODEL.EQ.'4013')GOTO1200
35160        IF(IMODEL.EQ.'4014')GOTO1200
35161        IF(IMODEL.EQ.'4016')GOTO1200
35162        IF(IMODEL.EQ.'4054')GOTO1200
35163C
35164        IF(IMODEL.EQ.'4020')GOTO1300
35165        IF(IMODEL.EQ.'4022')GOTO1300
35166        IF(IMODEL.EQ.'4025')GOTO1300
35167        IF(IMODEL.EQ.'4027')GOTO1300
35168C
35169        IF(IMODEL.EQ.'4105')GOTO1100
35170        IF(IMODEL.EQ.'4107')GOTO1100
35171        IF(IMODEL.EQ.'4109')GOTO1100
35172        IF(IMODEL.EQ.'4115')GOTO1100
35173        IF(IMODEL.EQ.'4107')GOTO1100
35174        IF(IMODEL.EQ.'4109')GOTO1100
35175C
35176        IF(IMODEL.EQ.'4113')GOTO1200
35177        IF(IMODEL.EQ.'4114')GOTO1200
35178C
35179        IF(IMODEL.EQ.'4662')GOTO1200
35180C
35181        GOTO1100
35182      ELSEIF(IMANUF.EQ.'HP')THEN
35183        IF(IMODEL.EQ.'7221')GOTO2100
35184        IF(IMODEL.EQ.'2622')GOTO2300
35185        IF(IMODEL.EQ.'2623')GOTO2300
35186        IF(IMODEL.EQ.'2627')GOTO2300
35187        IF(IMODEL.EQ.'2647')GOTO2300
35188        GOTO2200
35189      ELSEIF(IMANUF.EQ.'LIBP')THEN
35190        GOTO2600
35191      ELSEIF(IMANUF.EQ.'REGI')THEN
35192        GOTO8100
35193      ELSEIF(IMANUF.EQ.'GKS ')THEN
35194        GOTO11000
35195      ELSEIF(IMANUF.EQ.'LAHE')THEN
35196        IF(IMODEL.EQ.'INTE')GOTO4900
35197        IF(IMODEL.EQ.'WINT')GOTO4950
35198        GOTO4600
35199      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
35200        GOTO13000
35201      ELSEIF(IMANUF.EQ.'QUIC')THEN
35202        GOTO9100
35203      ELSEIF(IMANUF.EQ.'CALC')THEN
35204        GOTO4100
35205      ELSEIF(IMANUF.EQ.'ZETA')THEN
35206        GOTO5100
35207      ELSEIF(IMANUF.EQ.'TURB')THEN
35208        GOTO10000
35209      ELSEIF(IMANUF.EQ.'SUN ')THEN
35210        GOTO6600
35211      ENDIF
35212      GOTO9000
35213C
35214C               *******************************************************
35215C               **  STEP 11--                                        **
35216C               **  TREAT THE TEKTRONIX 4006, 4010, 4050, AND 4052   **
35217C               **  (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES  **
35218C               **  WHICH ARE SMALL SCREEN AND SO HAVE ONLY          **
35219C               **  1 CHARCTER SIZE).                                **
35220C               **  REFERENCE--IGL MANUAL, PAGE 6-22                 **
35221C               *******************************************************
35222C
35223 1100 CONTINUE
35224      JSIZE=1
35225      PWIDPP=1.410*RATIV1
35226      PHOGPP=0.385*RATIV1
35227      PHEIPP=1.795*RATIV1
35228      PVEGPP=1.026*RATIV1
35229      JWIDT2=INT(PWIDPP+0.5)
35230      JHOGA2=INT(PHOGPP+0.5)
35231      JHEIG2=INT(PHEIPP+0.5)
35232      JVEGA2=INT(PVEGPP+0.5)
35233      PWIDT2=1.410*RATIVH
35234      PHOGA2=0.385*RATIVH
35235      PHEIG2=1.795
35236      PVEGA2=1.026
35237      GOTO9000
35238C
35239C               ********************************************************
35240C               **  STEP 12--                                         **
35241C               **  TREAT THE TEKTRONIX 4012, 4013, 4014, 4016, 4054, **
35242C               **  AND 4114 (THESE ARE ALL NON-COLOR (= MONOCHROME)  **
35243C               **  DEVICES WHICH ARE LARGE SCREEN AND SO HAVE        **
35244C               **  4 CHARCTER SIZES.)                                **
35245C               **  REFERENCE--IGL MANUAL, PAGE 6-22                  **
35246C               ********************************************************
35247C
35248 1200 CONTINUE
35249      IF(PHEIG2.LT.0.75)THEN
35250        JSIZE=1
35251        PWIDPP=0.776*RATIV1
35252        PHOGPP=0.212*RATIV1
35253        PHEIPP=0.987*RATIV1
35254        PVEGPP=0.564*RATIV1
35255        JWIDT2=INT(PWIDPP+0.5)
35256        JHOGA2=INT(PHOGPP+0.5)
35257        JHEIG2=INT(PHEIPP+0.5)
35258        JVEGA2=INT(PVEGPP+0.5)
35259        PWIDT2=0.776*RATIVH
35260        PHOGA2=0.212*RATIVH
35261        PHEIG2=0.987
35262        PVEGA2=0.564
35263      ELSEIF(0.75.LT.PHEIG2.AND.PHEIG2.LE.1.25)THEN
35264        JSIZE=2
35265        PWIDPP=0.856*RATIV1
35266        PHOGPP=0.233*RATIV1
35267        PHEIPP=1.089*RATIV1
35268        PVEGPP=0.623*RATIV1
35269        JWIDT2=INT(PWIDPP+0.5)
35270        JHOGA2=INT(PHOGPP+0.5)
35271        JHEIG2=INT(PHEIPP+0.5)
35272        JVEGA2=INT(PVEGPP+0.5)
35273        PWIDT2=0.856*RATIVH
35274        PHOGA2=0.233*RATIVH
35275        PHEIG2=1.089
35276        PVEGA2=0.623
35277      ELSEIF(1.25.LT.PHEIG2.AND.PHEIG2.LE.1.75)THEN
35278        JSIZE=3
35279        PWIDPP=1.283*RATIV1
35280        PHOGPP=0.350*RATIV1
35281        PHEIPP=1.633*RATIV1
35282        PVEGPP=0.933*RATIV1
35283        JWIDT2=INT(PWIDPP+0.5)
35284        JHOGA2=INT(PHOGPP+0.5)
35285        JHEIG2=INT(PHEIPP+0.5)
35286        JVEGA2=INT(PVEGPP+0.5)
35287        PWIDT2=1.283*RATIVH
35288        PHOGA2=0.350*RATIVH
35289        PHEIG2=1.633
35290        PVEGA2=0.933
35291      ELSE
35292        JSIZE=4
35293        PWIDPP=1.410*RATIV1
35294        PHOGPP=0.385*RATIV1
35295        PHEIPP=1.795*RATIV1
35296        PVEGPP=1.026*RATIV1
35297        JWIDT2=INT(PWIDPP+0.5)
35298        JHOGA2=INT(PHOGPP+0.5)
35299        JHEIG2=INT(PHEIPP+0.5)
35300        JVEGA2=INT(PVEGPP+0.5)
35301        PWIDT2=1.410*RATIVH
35302        PHOGA2=0.385*RATIVH
35303        PHEIG2=1.795
35304        PVEGA2=1.026
35305      ENDIF
35306      GOTO9000
35307C
35308C               **************************************************************
35309C               **  STEP 13--                                               **
35310C               **  TREAT THE TEKTRONIX 402X CASES                          **
35311C               **  REFERENCE--IGL MANUAL, PAGE 6-22
35312C               **************************************************************
35313C
35314 1300 CONTINUE
35315      JSIZE=1
35316      PWIDPP=1.667*RATIV1
35317      PHOGPP=0.238*RATIV1
35318      PHEIPP=2.143*RATIV1
35319      PVEGPP=1.190*RATIV1
35320      JWIDT2=INT(PWIDPP+0.5)
35321      JHOGA2=INT(PHOGPP+0.5)
35322      JHEIG2=INT(PHEIPP+0.5)
35323      JVEGA2=INT(PVEGPP+0.5)
35324      PWIDT2=1.667*RATIVH
35325      PHOGA2=0.238*RATIVH
35326      PHEIG2=2.143
35327      PVEGA2=1.190
35328      GOTO9000
35329C
35330C               ******************************************************
35331C               **  STEP 21--                                       **
35332C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
35333C               **  (MULTI-COLOR PENPLOTTER)                        **
35334C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
35335C               **             OPERATING AND PROGRAMMING MANUAL,    **
35336C               **             PAGE XX.                             **
35337C               ******************************************************
35338C
35339 2100 CONTINUE
35340      GOTO9000
35341C
35342C               ******************************************************
35343C               **  STEP 22--                                       **
35344C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
35345C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
35346C               **  (MULTI-COLOR PENPLOTTERS)                       **
35347C               ******************************************************
35348C
35349 2200 CONTINUE
35350      GOTO9000
35351C
35352C               ******************************************************
35353C               **  STEP 23--                                       **
35354C               **  TREAT THE HEWLETT-PACKARD 2622  CASES           **
35355C               ******************************************************
35356C
35357 2300 CONTINUE
35358      GOTO9000
35359C
35360C               ******************************************************
35361C               **  STEP 26--                                       **
35362C               **  TREAT THE UNIX LIBPLOT          CASE            **
35363C               **  WE CREATE A 0 TO 100 COORDINATE SCALE FOR       **
35364C               **  LIBPLOT, SO NO NEED TO ADJUST SIZE VALUES       **
35365C               ******************************************************
35366C
35367 2600 CONTINUE
35368      GOTO9000
35369C
35370C               ******************************************************
35371C               **  STEP 31--                                       **
35372C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
35373C               ******************************************************
35374C
35375 3100 CONTINUE
35376      GOTO9000
35377C
35378C               *********************************************************
35379C               **  STEP 32--                                          **
35380C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE  **
35381C               *********************************************************
35382C
35383 3200 CONTINUE
35384      GOTO9000
35385C
35386C               *******************************************************
35387C               **  STEP 33--                                        **
35388C               **  TREAT THE CGM CASE                               **
35389C               *******************************************************
35390C
35391 3300 CONTINUE
35392      GOTO9000
35393C
35394C               ***************************************************
35395C               **  STEP 34--                                    **
35396C               **  TREAT THE CGM (BINARY)                 CASE  **
35397C               ***************************************************
35398C
35399 3400 CONTINUE
35400      GOTO9000
35401C
35402C               ******************************************************
35403C               **  STEP 41--                                       **
35404C               **  TREAT THE CALCOMP XXXXXX CASE                   **
35405C               **  (NOT DONE)                                      **
35406C               **  REFERENCE--XX                                   **
35407C               **             XX                                   **
35408C               **             PAGES XX AND XX                      **
35409C               **  THE DEFAULT WIDTH OF A CALCOMP CHARACTER IS THE **
35410C               **  SAME AS THE HEIGHT (BUT WIDTH = CHARACTER PLUS  **
35411C               **  SPACING WHILE HEIGHT = CHARACTER ONLY).  THERE IS*
35412C               **  "SETCHR" CALL FOR SOME CALCOMP PLOTTERS THAT    **
35413C               **  ALLOWS THE ASPECT RATIO TO BE SET, BUT NOT      **
35414C               **  IMPLEMENTED HERE SINCE NOT SUPPORTED BY ALL     **
35415C               **  CALCOMP PLOTTERS (PARTICULARLY EMULATION PACKAGES*
35416C               ******************************************************
35417C
35418 4100 CONTINUE
35419      PWIDPP=RATIV1*PWIDT2
35420      PWIDT2=PHEIG2*RATIVH
35421      PHOGPP=0.
35422      PHEIPP=RATIV1*PHEIG2
35423      PVEGPP=0.0
35424      JWIDT2=INT(PWIDPP+0.5)
35425      JHOGA2=INT(PHOGPP+0.5)
35426      JHEIG2=INT(PHEIPP+0.5)
35427      JVEGA2=INT(PVEGPP+0.5)
35428      PHOGA2=0.0
35429      PVEGA2=0.0
35430      GOTO9000
35431C
35432C               ******************************************************
35433C               **  STEP 46--                                       **
35434C               **  TREAT THE LAHEY   XXXXXX CASE                   **
35435C               **  REFERENCE--Programmer's Reference, Revision C   **
35436C               **             Lahey Computer Systems, January, 1992**
35437C               **             PAGES 51 THRU 65                     **
35438C               ******************************************************
35439C
35440 4600 CONTINUE
35441      PWIDPP=RATIV1*PWIDT2
35442      PWIDT2=PHEIG2*RATIVH
35443      PHOGPP=0.
35444      PHEIPP=RATIV1*PHEIG2
35445      PVEGPP=0.0
35446      JWIDT2=INT(PWIDPP+0.5)
35447      JHOGA2=INT(PHOGPP+0.5)
35448      JHEIG2=INT(PHEIPP+0.5)
35449      JVEGA2=INT(PVEGPP+0.5)
35450      PHOGA2=0.0
35451      PVEGA2=0.0
35452      GOTO9000
35453C
35454C               ******************************************************
35455C               **  STEP 47--                                       **
35456C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
35457C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
35458C               ******************************************************
35459C
35460 4700 CONTINUE
35461      PHEIPP=ANUMVP*PHEIG2/100.
35462      PVEGPP=ANUMVP*PVEGA2/100.
35463      PWIDPP=PHEIPP*0.6
35464      PHOGPP=PVEGPP*0.6
35465      JHEIG2=INT(PHEIPP+0.5)
35466      JVEGA2=INT(PVEGPP+0.5)
35467      JWIDT2=INT(PWIDPP+0.5)
35468      JHOGA2=INT(PHOGPP+0.5)
35469      PHEIG2=REAL(JHEIG2)*100./ANUMVP
35470      PVEGA2=REAL(JVEGA2)*100./ANUMVP
35471      PWIDT2=REAL(JWIDT2)*100./ANUMVP
35472      PHOGA2=REAL(JHOGA2)*100./ANUMVP
35473      GOTO9000
35474C
35475C               ******************************************************
35476C               **  STEP 48--                                       **
35477C               **  TREAT THE OPEN-GL DRIVER                        **
35478C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
35479C               ******************************************************
35480C
35481 4800 CONTINUE
35482      GOTO9000
35483C
35484C               ******************************************************
35485C               **  STEP 49--                                       **
35486C               **  TREAT THE LAHEY INTERACTOR CASE                 **
35487C               ******************************************************
35488C
35489 4900 CONTINUE
35490      PWIDPP=0.0
35491      PHOGPP=0.0
35492      PHEIPP=0.0
35493      PVEGPP=0.0
35494      JWIDT2=0
35495      JHOGA2=0
35496      JHEIG2=0
35497      JVEGA2=0
35498      PHEIG2=(25.0/100.0)*PHEIG2
35499      PWIDT2=(75.0/100.0)*PWIDT2
35500      PHOGA2=0.0
35501      PVEGA2=0.0
35502      GOTO9000
35503C
35504C               ******************************************************
35505C               **  STEP 49B-                                       **
35506C               **  TREAT THE LAHEY WINTERACTOR CASE                **
35507C               ******************************************************
35508C
35509 4950 CONTINUE
35510      PWIDPP=0.0
35511      PHOGPP=0.0
35512      PHEIPP=0.0
35513      PVEGPP=0.0
35514      JWIDT2=0
35515      JHOGA2=0
35516      JHEIG2=0
35517      JVEGA2=0
35518      GOTO9000
35519C
35520C
35521C               ******************************************************
35522C               **  STEP 51--                                       **
35523C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
35524C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
35525C               **             MODELS 3600SX AND 3653SX             **
35526C               **             PAGES B-0 AND B-1                    **
35527C               **  NOTE: ZETA LIBRARY HAS ASPECT RATIO TO CONTROL  **
35528C               **             WIDTH/HEIGHT RATIO.  THE WIDTH       **
35529C               **             INCLUDES BOTH THE CHARACTER WIDTH AND**
35530C               **             THE INTERCHARACTER SPACING WHILE THE **
35531C               **             HEIGHT ONLY INCLUDES THE CHARACTER.  **
35532C               **             ALSO, BASE THE WIDTH ON THE VERTICAL **
35533C               **             AXIS (FOR CONSISTENCY) AND THEN      **
35534C               **             RECALCULATE PWIDT2 (BASED ON         **
35535C               **             HORIZONTAL SIZE)                     **
35536C               ******************************************************
35537C
35538 5100 CONTINUE
35539      PTEMP=PWIDT2+PHOGA2
35540      PRATIO=PTEMP/PHEIG2
35541      PWIDPP=PTEMP*RATIV1
35542      PHOGPP=0.
35543      PHEIPP=RATIV1*PHEIG2
35544      PVEGPP=0.0
35545      JWIDT2=INT(PWIDPP+0.5)
35546      JHOGA2=INT(PHOGPP+0.5)
35547      JHEIG2=INT(PHEIPP+0.5)
35548      JVEGA2=INT(PVEGPP+0.5)
35549      PWIDT2=PTEMP*RATIVH
35550      PHOGA2=0.
35551      PVEGA2=0.
35552      GOTO9000
35553C
35554C               ******************************************************
35555C               **  STEP 66--                                       **
35556C               **  TREAT THE SUN CASE                              **
35557C               ******************************************************
35558C
35559 6600 CONTINUE
35560      PWIDPP=0.50*RATIV1*PHEIG2
35561      PHOGPP=0.214*RATIV1*PHEIG2
35562      PHEIPP=1.000*RATIV1*PHEIG2
35563      PVEGPP=0.750*RATIV1*PHEIG2
35564      JWIDT2=INT(PWIDPP+0.5)
35565      JHOGA2=INT(PHOGPP+0.5)
35566      JHEIG2=INT(PHEIPP+0.5)
35567      JVEGA2=INT(PVEGPP+0.5)
35568      PWIDT2=0.50*RATIVH*PHEIG2
35569      PHOGA2=0.214*RATIVH*PHEIG2
35570      PVEGA2=0.750*PHEIG2
35571      GOTO9000
35572C
35573C               ******************************************************
35574C               **  STEP 81--                                       **
35575C               **  TREAT THE REGIS          CASE                   **
35576C               ******************************************************
35577C
35578C     MARCH, 1991.  HANDLE VARIOUS CHARACTER SIZES CORRECTLY.
35579C
35580C     THE SIZE OF THE DEFAULT FONT IN TURBO-C IS 8 BY 8
35581C     PIXELS.  THIS STANDARD SIZE MAY BE SCALED UP BY
35582C     FACTORS OF 1, 2, ..., UP TO 10.  THE DISPLAY CELL
35583C     SIZE IS THE SIZE OF THE CHARACTER CELL (CHARACTER
35584C     + MARGIN), WHILE THE UNIT CELL SIZE IS THE SIZE OF
35585C     THE CHARACTER ONLY.  THE DIFFERENCE BETWEEN THEM
35586C     DEFINES THE HORIZONTAL GAP.  NOTE THAT THE
35587C     VERTICAL GAP IS BUILT INTO THE CHARACTER ITSELF
35588C     (I.E., PVEGA2=0.).  THE FOLLOWING TABLE GIVES THE
35589C     AVAILABLE CHARACTER SIZES:
35590C
35591C     SET NUMBER         CELL SIZE          CHARACTER SIZE
35592C       (JSIZE)       WIDTH BY HEIGHT       WIDTH BY HEIGHT
35593C
35594C     0      GET FROM ALAN
35595C     1                      [  9, 20]                [  8, 20]
35596C     2                      [ 18, 30]                [ 16, 30]
35597C     3                      [ 27, 45]                [ 24, 45]
35598C     4                      [ 36, 60]                [ 32, 60]
35599C     5                      [ 45, 75]                [ 40, 75]
35600C     6                      [ 54, 90]                [ 48, 90]
35601C     7                      [ 63,105]                [ 56,105]
35602C     8                      [ 72,120]                [ 64,120]
35603C     9                      [ 81,135]                [ 72,135]
35604C    10                      [ 90,150]                [ 90,150]
35605C    11                      [ 99,165]                [ 88,165]
35606C    12                      [108,180]                [ 96,180]
35607C    13                      [117,195]                [104,195]
35608C    14                      [126,210]                [112,210]
35609C    15                      [135,225]                [120,225]
35610C    16                      [144,240]                [128,240]
35611C
35612C     RATIV1*PHEIG2 IS THE HEIGHT (IN PIXELS
35613C     REQUESTED).  THIS SIZE WILL BE ROUNDED TO THE
35614C     CLOSEST PIXEL HEIGHT IN THE ABOVE TABLE.
35615C
35616 8100 CONTINUE
35617      ATEMP=PHEIG2*RATIV1
35618      IF(ATEMP.LE.15.0)THEN
35619        JSIZE=0
35620        PWIDPP=8.0
35621        PHOGPP=1.0
35622        PHEIPP=10.0
35623        PVEGPP=0.0
35624      ELSE IF(ATEMP.LE.25.0)THEN
35625        JSIZE=1
35626        PWIDPP=8.0
35627        PHOGPP=1.0
35628        PHEIPP=20.0
35629        PVEGPP=0.0
35630      ELSE IF(ATEMP.LE.37.5)THEN
35631        JSIZE=2
35632        PWIDPP=16.0
35633        PHOGPP=2.0
35634        PHEIPP=30.0
35635        PVEGPP=0.0
35636      ELSE IF(ATEMP.LE.52.5)THEN
35637        JSIZE=3
35638        PWIDPP=24.0
35639        PHOGPP=3.0
35640        PHEIPP=45.0
35641        PVEGPP=0.0
35642      ELSE IF(ATEMP.LE.67.5)THEN
35643        JSIZE=4
35644        PWIDPP=32.0
35645        PHOGPP=4.0
35646        PHEIPP=60.0
35647        PVEGPP=0.0
35648      ELSE IF(ATEMP.LE.82.5)THEN
35649        JSIZE=5
35650        PWIDPP=40.0
35651        PHOGPP=5.0
35652        PHEIPP=75.0
35653        PVEGPP=0.0
35654      ELSE IF(ATEMP.LE.97.5)THEN
35655        JSIZE=6
35656        PWIDPP=48.0
35657        PHOGPP=6.0
35658        PHEIPP=90.0
35659        PVEGPP=0.0
35660      ELSE IF(ATEMP.LE.112.5)THEN
35661        JSIZE=7
35662        PWIDPP=56.0
35663        PHOGPP=7.0
35664        PHEIPP=105.0
35665        PVEGPP=0.0
35666      ELSE IF(ATEMP.LE.127.5)THEN
35667        JSIZE=8
35668        PWIDPP=64.0
35669        PHOGPP=8.0
35670        PHEIPP=120.0
35671        PVEGPP=0.0
35672      ELSE IF(ATEMP.LE.142.5)THEN
35673        JSIZE=9
35674        PWIDPP=72.0
35675        PHOGPP=9.0
35676        PHEIPP=135.0
35677        PVEGPP=0.0
35678      ELSE IF(ATEMP.LE.157.5)THEN
35679        JSIZE=10
35680        PWIDPP=80.0
35681        PHOGPP=10.0
35682        PHEIPP=150.0
35683        PVEGPP=0.0
35684      ELSE IF(ATEMP.LE.172.5)THEN
35685        JSIZE=11
35686        PWIDPP=88.0
35687        PHOGPP=11.0
35688        PHEIPP=165.0
35689        PVEGPP=0.0
35690      ELSE IF(ATEMP.LE.187.5)THEN
35691        JSIZE=12
35692        PWIDPP=96.0
35693        PHOGPP=12.0
35694        PHEIPP=180.0
35695        PVEGPP=0.0
35696      ELSE IF(ATEMP.LE.202.5)THEN
35697        JSIZE=13
35698        PWIDPP=104.0
35699        PHOGPP=13.0
35700        PHEIPP=195.0
35701        PVEGPP=0.0
35702      ELSE IF(ATEMP.LE.217.5)THEN
35703        JSIZE=14
35704        PWIDPP=112.0
35705        PHOGPP=14.0
35706        PHEIPP=210.0
35707        PVEGPP=0.0
35708      ELSE IF(ATEMP.LE.232.5)THEN
35709        JSIZE=15
35710        PWIDPP=120.0
35711        PHOGPP=15.0
35712        PHEIPP=225.0
35713        PVEGPP=0.0
35714      ELSE
35715        JSIZE=16
35716        PWIDPP=128.0
35717        PHOGPP=16.0
35718        PHEIPP=240.0
35719        PVEGPP=0.0
35720      END IF
35721      JWIDT2=INT(PWIDPP+0.5)
35722      JHOGA2=INT(PHOGPP+0.5)
35723      JHEIG2=INT(PHEIPP+0.5)
35724      JVEGA2=INT(PVEGPP+0.5)
35725      PWIDT2=(PWIDPP/ANUMHP)*100.0
35726      PHOGA2=(PHOGPP/ANUMHP)*100.0
35727      PHEIG2=(PHEIPP/ANUMVP)*100.0
35728      PVEGA2=0.0
35729      GOTO9000
35730C
35731C               ******************************************************
35732C               **  STEP 86--                                       **
35733C               **  TREAT THE POSTSCRIPT            CASES           **
35734C               **  SIZE IS IN POSTSCRIPT UNITS (1/72 = 1 POINT BY  **
35735C               **  DEFAULT).  DATAPLOT SCALES UNITS BY POINTS PER  **
35736C               **  INCH, SO 1 UNIT IS (1/POINTS PER INCH) = 1 PIXEL**
35737C               **  FOR DATAPLOT.                                   **
35738C               **  NOTE THAT POSTSCRIPT FONTS ARE PROPORTIONALLY   **
35739C               **  SPACED, SO USE 0.6 OF HEIGHT AS DUMMY VALUE.    **
35740C               ******************************************************
35741C
35742 8600 CONTINUE
35743      PPI=PSTPPI
35744      PHEIPP=ANUMVP*PHEIG2/100.
35745      PVEGPP=ANUMVP*PVEGA2/100.
35746      PWIDPP=PHEIPP*0.6
35747      PHOGPP=PVEGPP*0.6
35748      JHEIG2=INT(PHEIPP+0.5)
35749      JVEGA2=INT(PVEGPP+0.5)
35750      JWIDT2=INT(PWIDPP+0.5)
35751      JHOGA2=INT(PHOGPP+0.5)
35752      PHEIG2=REAL(JHEIG2)*100./ANUMVP
35753      PVEGA2=REAL(JVEGA2)*100./ANUMVP
35754      PWIDT2=REAL(JWIDT2)*100./ANUMVP
35755      PHOGA2=REAL(JHOGA2)*100./ANUMVP
35756      GOTO9000
35757C
35758C               ******************************************************
35759C               **  STEP 91--                                       **
35760C               **  TREAT THE QUIC                  CASES           **
35761C               **  QMS AND TALARIS LASER PRINTERS                  **
35762C               **  SIZE DETERMINED BY THE FONT BEING USED          **
35763C               **  QUIC FONTS USE POINT SIZE.  (POINT=1/72IN)      **
35764C               **  10   - EDP FONT, 8 POINT, 14 CPI (21 DOT/CHAR)  **
35765C               **         LANDSCAPE, PORTRAIT                      **
35766C               **  104  - STANDARD ROMAN MEDIUM, 10 POINT, PROPORT.**
35767C               **         LANDSCAPE, PORTRAIT                      **
35768C               **  124  - STANDARD ROMAN BOLD, 10 POINT, PROPORT.  **
35769C               **                    PORTRAIT                      **
35770C               **  144  - STANDARD ROMAN ITALIC, 10 POINT, PROPORT.**
35771C               **                    PORTRAIT                      **
35772C               **  16   - SIMPLEX ROMAN, 5 POINT PROPORTIONAL      **
35773C               **                    PORTRAIT                      **
35774C               **  204  - APOLLO MEDIUM, 10 POINT, PROPORTIONAL    **
35775C               **         LANDSCAPE, PORTRAIT                      **
35776C               **  328  - COMPLEX ROMAN BOLD, PROPORTIONAL 15 POINT**
35777C               **                    PORTRAIT                      **
35778C               **  404  - Q-TYPEWRITER, 10 POINT, (30 DOT/CHAR)    **
35779C               **                    PORTRAIT                      **
35780C               **  444  - Q-TYPEWRITER ITALIC, 30 DOTS WIDE        **
35781C               **                    PORTRAIT                      **
35782C               **  NOTE: THE ABOVE ARE "HARDWARE" FONTS.  THE      **
35783C               **        FOLLOWING ARE "DOWNLOADABLE" FONTS THAT   **
35784C               **        MAY NOT BE AVAILABLE ON A GIVEN MACHINE   **
35785C               **                                                  **
35786C               **  521  - TEKTRONIX SMALL, 12 CPI (25 DOT/CHAR) 8.0 POINT
35787C               **         LANDSCAPE                                **
35788C               **  522  - TEKTRONIX MEDIU, 10 CPI (30 DOT/CHAR)10.3 POINT
35789C               **         LANDSCAPE                                **
35790C               **  523  - TEKTRONIX BIG,  7.9 CPI (38 DOT/CHAR)12.3 POINT
35791C               **         LANDSCAPE                                **
35792C               **  524  - TEKTRONIX XBIG, 7.3 CPI (41 DOT/CHAR)13.7 POINT
35793C               **         LANDSCAPE                                **
35794C               **  532  - UNION 10 POINT, 12 CPI (25 DOTS/CHAR)    **
35795C               **                    PORTRAIT                      **
35796C               **  517  - Q-GREEK 10 POINT, 10 CPI (30 DOTS/CHAR)  **
35797C               **         LANDSCAPE, PORTRAIT                      **
35798C               **  536  - Q-GREEK 10 POINT, 12 CPI (25 DOTS/CHAR)  **
35799C               **         LANDSCAPE, PORTRAIT                      **
35800C               **  904  - Q-GOTHIC 10 POINT, 12 CPI (25 DOTS/CHAR) **
35801C               **         LANDSCAPE, PORTRAIT                      **
35802C               **  924  - Q-GOTHIC ITALIC, 10 POINT, 12 CPI (25 DOTS)
35803C               **         LANDSCAPE, PORTRAIT                      **
35804C               **  IF THE REQUESTED FONT IS NOT AVAILABLE IN THE   **
35805C               **  GIVEN ORIENTATION (LANDSCAPE OR PORTRAIT), THE  **
35806C               **  EDP FONT WILL BE USED (BUT VALUE OF IQUIFN NOT  **
35807C               **  MODIFIED).                                      **
35808C               **  THE CPI GIVEN FOR THE PROPORTIONAL FONTSIS JUST **
35809C               **  A GUIDE, TABLES ARE USED TO FIND LENGTH OF STRING*
35810C               **  REFERENCE--QUIC PROGRAMMERS MANUAL,             **
35811C               **             APPENDIX B                           **
35812C               ******************************************************
35813C
35814 9100 CONTINUE
35815      PPI=QUIPPI
35816      IFONTT=IQUIFN
35817      IF(IORNSW.EQ.'PORT' .AND.(
35818     1   IFONTT.EQ.521 .OR. IFONTT.EQ.522 .OR.
35819     1   IFONTT.EQ.523 .OR. IFONTT.EQ.524))IFONTT=10
35820      IF(IORNSW.NE.'PORT'.AND.(
35821     1   IFONTT.EQ.124 .OR. IFONTT.EQ.144 .OR.
35822     1   IFONTT.EQ.16  .OR. IFONTT.EQ.328 .OR.
35823     1   IFONTT.EQ.998 .OR. IFONTT.EQ.404 .OR.
35824     1   IFONTT.EQ.444 .OR. IFONTT.EQ.532))IFONTT=10
35825      IF(IFONTT.EQ.16) THEN
35826        APOINT=5.0
35827        AWIDTH=21.
35828      ELSE IF(IFONTT.EQ.10) THEN
35829        APOINT=8.
35830        AWIDTH=21.
35831      ELSE IF(IFONTT.EQ.104)THEN
35832        APOINT=10.
35833        AWIDTH=21.
35834      ELSE IF(IFONTT.EQ.124)THEN
35835        APOINT=10.
35836         AWIDTH=21.
35837      ELSE IF(IFONTT.EQ.144)THEN
35838        APOINT=10.
35839        AWIDTH=21.
35840      ELSE IF(IFONTT.EQ.204)THEN
35841        APOINT=10.
35842        AWIDTH=21.
35843      ELSE IF(IFONTT.EQ.404)THEN
35844        APOINT=10.
35845         AWIDTH=30.
35846      ELSE IF(IFONTT.EQ.444)THEN
35847        APOINT=10.
35848        AWIDTH=30.
35849      ELSE IF(IFONTT.EQ.328)THEN
35850        APOINT=15.
35851        AWIDTH=21.
35852      ELSE IF(IFONTT.EQ.998)THEN
35853        APOINT=15.
35854        AWIDTH=21.
35855      ELSE IF(IFONTT.EQ.521)THEN
35856        APOINT=8.
35857        AWIDTH=25.
35858      ELSE IF(IFONTT.EQ.522)THEN
35859        APOINT=10.3
35860        AWIDTH=30.
35861      ELSE IF(IFONTT.EQ.523)THEN
35862        APOINT=12.3
35863        AWIDTH=38.
35864      ELSE IF(IFONTT.EQ.524)THEN
35865        APOINT=13.7
35866        AWIDTH=41.
35867      ELSE IF(IFONTT.EQ.532)THEN
35868        APOINT=10.
35869        AWIDTH=25.
35870      ELSE IF(IFONTT.EQ.517)THEN
35871        APOINT=10.
35872        AWIDTH=30.
35873      ELSE IF(IFONTT.EQ.536)THEN
35874        APOINT=10.
35875        AWIDTH=25.
35876      ELSE IF(IFONTT.EQ.664)THEN
35877        APOINT=10.
35878        AWIDTH=25.
35879      ELSE IF(IFONTT.EQ.904)THEN
35880        APOINT=10.
35881        AWIDTH=25.
35882      ELSE IF(IFONTT.EQ.924)THEN
35883        APOINT=10.
35884        AWIDTH=25.
35885      ELSE
35886        APOINT=8.
35887        AWIDTH=21.
35888        IFONTT=10
35889      END IF
35890      PHEIPP=(APOINT/72.)*PPI
35891      PVEGPP=0.
35892      PWIDPP=AWIDTH
35893      PHOGPP=0.
35894      JHEIG2=INT(PHEIPP+0.5)
35895      JVEGA2=0
35896      JWIDT2=INT(PWIDPP+0.5)
35897      JHOGA2=0
35898      PHEIG2=PHEIPP*100./ANUMVP
35899      PVEGA2=0.
35900      PWIDT2=PWIDPP*100./ANUMHP
35901      PHOGA2=0.
35902      GOTO9000
35903C
35904C               ******************************************************
35905C               **  STEP 96--                                       **
35906C               **  TREAT THE X11            CASE                   **
35907C               **  THE UNDERLYING C LIBRARY WILL HANDLE CHARACTER  **
35908C               **  SIZE, JUSTIFICATION, AND POSITIONING VIA XLIB   **
35909C               **  CALLS.  THEREFORE, THIS IS A NULL ROUTINE.      **
35910C               ******************************************************
35911C
35912 9600 CONTINUE
35913      GOTO9000
35914C
35915CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
35916C               *************************************************
35917C               **  STEP 100--                                 **
35918C               **  TREAT THE VGA VIA TURBO-C       CASE       **
35919C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
35920C               **             ENHANCEMENTS, PAGE 93.          **
35921C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
35922C               **             PAGE 327.                       **
35923C               **  REFERENCE--WEISKAMP, POWER GRAPHICS
35924C               **             USING TURBO C, PAGE 52.         **
35925C               *************************************************
35926C
35927C     THE CELL SIZE OF THE DEFAULT FONT IN TURBO-C IS 8 BY 8
35928C     PIXELS.  THIS STANDARD SIZE MAY BE SCALED UP BY
35929C     FACTORS OF 1, 2, ..., UP TO 10.  THE CELL SIZE IS
35930C     THE SIZE OF THE CHARACTER + MARGIN.  THE CHARACTER
35931C     SIZE IS THE SIZE OF THE CHARACTER ONLY.  NOTE THAT
35932C     THE VERTICAL GAP AND HORIZONTAL GAP IS BUILT INTO   ?????
35933C     THE CHARACTER ONLY (I.E., PVEGA2 = PHOGA2 = 0).
35934C     THE FOLLOWING TABLE GIVES THE AVAILABLE CHARACTER SIZES:
35935C
35936C     SET NUMBER         CELL SIZE          CHARACTER SIZE
35937C       (JSIZE)       HEIGHT BY WIDTH       HEIGHT BY WIDTH
35938C      1                   8,8                    7,7
35939C      2                  16,16                  14,14
35940C      3                  24,24                  21,21
35941C      4                  32,32                  28,28
35942C      5                  40,40                  35,35
35943C      6                  48,48                  42,42
35944C      7                  56,56                  49,49
35945C      8                  64,64                  56,56
35946C      9                  72,72                  63,63
35947C     10                  80,80                  70,70
35948C
35949C     RATIV1*PHEIG2 IS THE HEIGHT (IN PIXELS
35950C     REQUESTED).  THIS SIZE WILL BE ROUNDED TO THE
35951C     CLOSEST PIXEL HEIGHT IN THE ABOVE TABLE.
35952C
3595310000 CONTINUE
35954      ATEMP=PHEIG2*RATIV1
35955      IF(ATEMP.LE.12.0)THEN
35956        JSIZE=1
35957        PWIDPP=8.0
35958        PHOGPP=0.0
35959        PHEIPP=8.0
35960        PVEGPP=0.0
35961      ELSE IF(ATEMP.LE.20.0)THEN
35962        JSIZE=2
35963        PWIDPP=16.0
35964        PHOGPP=0.0
35965        PHEIPP=16.0
35966        PVEGPP=0.0
35967      ELSE IF(ATEMP.LE.28.0)THEN
35968        JSIZE=3
35969        PWIDPP=24.0
35970        PHOGPP=0.0
35971        PHEIPP=24.0
35972        PVEGPP=0.0
35973      ELSE IF(ATEMP.LE.36.0)THEN
35974        JSIZE=4
35975        PWIDPP=32.0
35976        PHOGPP=0.0
35977        PHEIPP=32.0
35978        PVEGPP=0.0
35979      ELSE IF(ATEMP.LE.44.0)THEN
35980        JSIZE=5
35981        PWIDPP=40.0
35982        PHOGPP=0.0
35983        PHEIPP=40.0
35984        PVEGPP=0.0
35985      ELSE IF(ATEMP.LE.52.0)THEN
35986        JSIZE=6
35987        PWIDPP=48.0
35988        PHOGPP=0.0
35989        PHEIPP=48.0
35990        PVEGPP=0.0
35991      ELSE IF(ATEMP.LE.60.0)THEN
35992        JSIZE=7
35993        PWIDPP=56.0
35994        PHOGPP=0.0
35995        PHEIPP=56.0
35996        PVEGPP=0.0
35997      ELSE IF(ATEMP.LE.68.0)THEN
35998        JSIZE=8
35999        PWIDPP=64.0
36000        PHOGPP=0.0
36001        PHEIPP=64.0
36002        PVEGPP=0.0
36003      ELSE IF(ATEMP.LE.76.0)THEN
36004        JSIZE=9
36005        PWIDPP=72.0
36006        PHOGPP=0.0
36007        PHEIPP=72.0
36008        PVEGPP=0.0
36009      ELSE
36010        JSIZE=10
36011        PWIDPP=80.0
36012        PHOGPP=0.0
36013        PHEIPP=80.0
36014        PVEGPP=0.0
36015      END IF
36016      JWIDT2=INT(PWIDPP+0.5)
36017      JHOGA2=INT(PHOGPP+0.5)
36018      JHEIG2=INT(PHEIPP+0.5)
36019      JVEGA2=INT(PVEGPP+0.5)
36020      PWIDT2=(PWIDPP/ANUMHP)*100.0
36021      PHOGA2=0.0
36022      PHEIG2=(PHEIPP/ANUMVP)*100.0
36023      PVEGA2=0.0
36024      GOTO9000
36025C
36026C               ******************************************************
36027C               **  STEP 110--                                      **
36028C               **  TREAT THE GKS                DRIVER             **
36029C               ******************************************************
36030C
3603111000 CONTINUE
36032      GOTO9000
36033C
36034C               ******************************************************
36035C               **  STEP 120--                                      **
36036C               **  TREAT THE GD                     DRIVER         **
36037C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
36038C               **  1) JPEG                                         **
36039C               **  2) PNG                                          **
36040C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
36041C               ******************************************************
36042C
3604312000 CONTINUE
36044      PHEIPP=ANUMVP*PHEIG2/100.
36045      PVEGPP=ANUMVP*PVEGA2/100.
36046      PWIDPP=PHEIPP*0.6
36047      PHOGPP=PVEGPP*0.6
36048      JHEIG2=INT(PHEIPP+0.5)
36049      JVEGA2=INT(PVEGPP+0.5)
36050      JWIDT2=INT(PWIDPP+0.5)
36051      JHOGA2=INT(PHOGPP+0.5)
36052      PHEIG2=REAL(JHEIG2)
36053      PVEGA2=REAL(JVEGA2)
36054      PWIDT2=REAL(JWIDT2)
36055      PHOGA2=REAL(JHOGA2)
36056      GOTO9000
36057C
36058C               ******************************************************
36059C               **  STEP 130--                                      **
36060C               **  TREAT THE ABSOFT                 DRIVER         **
36061C               ******************************************************
36062C
3606313000 CONTINUE
36064      GOTO9000
36065C
36066C               ******************************************************
36067C               **  STEP 135--                                      **
36068C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
36069C               ******************************************************
36070C
3607113500 CONTINUE
36072      PHEIPP=ANUMVP*PHEIG2/100.
36073      PVEGPP=ANUMVP*PVEGA2/100.
36074      PWIDPP=PHEIPP*0.6
36075      PHOGPP=PVEGPP*0.6
36076      JHEIG2=INT(PHEIPP+0.5)
36077      JVEGA2=INT(PVEGPP+0.5)
36078      JWIDT2=INT(PWIDPP+0.5)
36079      JHOGA2=INT(PHOGPP+0.5)
36080      PHEIG2=REAL(JHEIG2)
36081      PVEGA2=REAL(JVEGA2)
36082      PWIDT2=REAL(JWIDT2)
36083      PHOGA2=REAL(JHOGA2)
36084      GOTO9000
36085C
36086C               ******************************************************
36087C               **  STEP 150--                                      **
36088C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
36089C               ******************************************************
36090C
36091C     LATEX SUPPORTS 10 SIZES.  NOTE THAT THE SPECIFIC SIZE USED WILL
36092C     DEPEND ON THE FONT SELECTED AND THE DEFAULT DOCUMENT POINT SIZE.
36093C     THE FOLLOWING POINT SIZES ARE BASED ON THE DEFAULT CMR FONT AND
36094C     A DEFAULT DOCUMENT SIZE OF 12PT.
36095C
36096C     WE ARE USING A 300DPI COORDINATE SCALE AND THERE ARE 72 POINTS PER
36097C     INCH.  THIS IMPLIES 4.16 PIXELS PER POINT (APPROXIMATELY).
36098C
36099C       1. \tiny          =  6 POINT  = 25 PIXELS
36100C       2. \scriptsize    =  8 POINT  = 33 PIXELS
36101C       3. \footnotesize  = 10 POINT  = 42 PIXELS
36102C       4. \small         = 10 POINT  = 42 PIXELS
36103C       5. \normalsize    = 12 POINT  = 50 PIXELS
36104C       6. \large         = 12 POINT  = 50 PIXELS
36105C       7. \Large         = 17 POINT  = 71 PIXELS
36106C       8. \LARGE         = 17 POINT  = 71 PIXELS
36107C       9. \huge          = 17 POINT  = 71 PIXELS
36108C      10. \Huge          = 17 POINT  = 71 PIXELS
36109C
3611015000 CONTINUE
36111      PHEIPP=ANUMVP*PHEIG2/100.
36112      IF(PHEIPP.LE.29.0)THEN
36113        JSIZE=1
36114        APNT=6.0
36115      ELSEIF(PHEIPP.LE.37.0)THEN
36116        JSIZE=2
36117        APNT=8.0
36118      ELSEIF(PHEIPP.LE.42.0)THEN
36119        JSIZE=3
36120        APNT=10.0
36121      ELSEIF(PHEIPP.LE.46.0)THEN
36122        JSIZE=4
36123        APNT=10.0
36124      ELSEIF(PHEIPP.LE.58.0)THEN
36125        JSIZE=5
36126        APNT=12.0
36127      ELSEIF(PHEIPP.LE.70.0)THEN
36128        JSIZE=6
36129        APNT=12.0
36130      ELSEIF(PHEIPP.LE.75.0)THEN
36131        JSIZE=7
36132        APNT=17.0
36133      ELSEIF(PHEIPP.LE.80.0)THEN
36134        JSIZE=8
36135        APNT=17.0
36136      ELSEIF(PHEIPP.LE.85.0)THEN
36137        JSIZE=9
36138        APNT=17.0
36139      ELSE
36140        JSIZE=10
36141        APNT=17.0
36142      ENDIF
36143      PHEIPP=APNT*4.16
36144      PVEGPP=0.0
36145      PWIDPP=PHEIPP*0.6
36146      PHOGPP=0.0
36147      JHEIG2=INT(PHEIPP+0.5)
36148      JVEGA2=INT(PVEGPP+0.5)
36149      JWIDT2=INT(PWIDPP+0.5)
36150      JHOGA2=INT(PHOGPP+0.5)
36151      PWIDT2=(PWIDPP/ANUMHP)*100.0
36152      PHOGA2=0.0
36153      PHEIG2=0.75*(PHEIPP/ANUMVP)*100.0
36154      PVEGA2=0.25*(PHEIPP/ANUMVP)*100.0
36155      GOTO9000
36156C
36157C               ******************************************************
36158C               **  STEP 160--                                      **
36159C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
36160C               ******************************************************
36161C
3616216000 CONTINUE
36163      PWIDPP=RATIV1*PWIDT2
36164      PWIDT2=PHEIG2*RATIVH
36165      PHOGPP=0.
36166      PHEIPP=RATIV1*PHEIG2
36167      PVEGPP=0.0
36168      JWIDT2=INT(PWIDPP+0.5)
36169      JHOGA2=INT(PHOGPP+0.5)
36170      JHEIG2=INT(PHEIPP+0.5)
36171      JVEGA2=INT(PVEGPP+0.5)
36172      PHOGA2=0.0
36173      PVEGA2=0.0
36174      GOTO9000
36175C
36176C               ******************************************************
36177C               **  STEP 170--                                      **
36178C               **  TREAT THE CAIRO                          DRIVER **
36179C               ******************************************************
36180C
3618117000 CONTINUE
36182      PHEIPP=ANUMVP*PHEIG2/100.
36183      PVEGPP=ANUMVP*PVEGA2/100.
36184      PWIDPP=PHEIPP*0.6
36185      PHOGPP=PVEGPP*0.6
36186      JHEIG2=INT(PHEIPP+0.5)
36187      JVEGA2=INT(PVEGPP+0.5)
36188      JWIDT2=INT(PWIDPP+0.5)
36189      JHOGA2=INT(PHOGPP+0.5)
36190      PHEIG2=REAL(JHEIG2)*100./ANUMVP
36191      PVEGA2=REAL(JVEGA2)*100./ANUMVP
36192      PWIDT2=REAL(JWIDT2)*100./ANUMVP
36193      PHOGA2=REAL(JHOGA2)*100./ANUMVP
36194      GOTO9000
36195C
36196C               ******************************************************
36197C               **  STEP 180--                                      **
36198C               **  TREAT THE WMF                            DRIVER **
36199C               ******************************************************
36200C
3620118000 CONTINUE
36202      GOTO9000
36203C
36204C               ******************************************************
36205C               **  STEP 190--                                      **
36206C               **  TREAT THE D3                             DRIVER **
36207C               ******************************************************
36208C
3620919000 CONTINUE
36210      GOTO9000
36211C               *****************
36212C               **  STEP 90--  **
36213C               **  EXIT       **
36214C               *****************
36215C
36216 9000 CONTINUE
36217      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRSI')THEN
36218        WRITE(ICOUT,999)
36219        CALL DPWRST('XXX','BUG ')
36220        WRITE(ICOUT,9011)
36221 9011   FORMAT('***** AT THE END       OF GRTRSI--')
36222        CALL DPWRST('XXX','BUG ')
36223        WRITE(ICOUT,9014)JSIZE
36224 9014   FORMAT('JSIZE = ',I8)
36225        CALL DPWRST('XXX','BUG ')
36226        WRITE(ICOUT,9015)JHEIG2,JWIDT2,JVEGA2,JHOGA2
36227 9015   FORMAT('JHEIG2,JWIDT2,JVEGA2,JHOGA2 = ',4I8)
36228        CALL DPWRST('XXX','BUG ')
36229        WRITE(ICOUT,9016)PHEIG2,PWIDT2,PVEGA2,PHOGA2
36230 9016   FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4G15.7)
36231        CALL DPWRST('XXX','BUG ')
36232        WRITE(ICOUT,9017)PHEIPP,PWIDPP,PVEGPP,PHOGPP
36233 9017   FORMAT('PHEIPP,PWIDPP,PVEGPP,PHOGPP = ',4G15.7)
36234        CALL DPWRST('XXX','BUG ')
36235      ENDIF
36236C
36237      RETURN
36238      END
36239      SUBROUTINE GRTRTH(ICASE,PTHICK,JTHICK,PTHIC2)
36240C
36241C     PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, TRANSLATE A DESIRED
36242C              LINE THICKNESS (IN PTHICK) GIVEN IN (0.0 TO 100.0)
36243C              REPRESENTATION INTO AN INTEGER NUMERIC REPRESENTATION (IN
36244C              JTHICK) THAT WILL BE UNDERSTOOD BY THE SPECIFIC GRAPHICS
36245C              DEVICE BEING USED.  ALSO, CREATE A SECOND VARIABLE
36246C              (PTHIC2) WHICH CONTAINS THE CLOSEST ALLOWABLE LINE
36247C              THICKNESS VALUE (IN 0.0 TO 100.0 UNITS) THAT IS PERMITTED
36248C              ON THE TEKTRONIX GRAPHICS DEVICE BEING USED.
36249C
36250C     WRITTEN BY--JAMES J. FILLIBEN
36251C                 STATISTICAL ENGINEERING DIVISION
36252C                 INFORMATION TECHNOLOGY LABORATORY
36253C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
36254C                 GAITHERSBURG, MD 20899-8980
36255C                 PHONE--301-975-2855
36256C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
36257C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
36258C     LANGUAGE--ANSI FORTRAN (1977)
36259C     VERSION NUMBER--83.6
36260C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
36261C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
36262C                                      DRIVER OBSOLETE
36263C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
36264C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
36265C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
36266C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
36267C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
36268C     UPDATED         --MARCH    1990. X11 (BY ALAN HECKERT)
36269C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
36270C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
36271C                                      DRIVER OBSOLETE
36272C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
36273C                                      OLD, CALCOMP STYLE
36274C                                      DRIVER OBSOLETE
36275C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
36276C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
36277C                                      USE BILL MITCHELLS OPENGL
36278C                                      BINDING FOR FORTRAN
36279C     UPDATED         --OCTOBER  1996. GKS (ALAN)
36280C                                      CODED, NOT TESTED
36281C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
36282C                                      PLACEHOLDER FOR NOW
36283C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
36284C                                      PLACEHOLDER FOR NOW
36285C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
36286C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
36287C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
36288C     UPDATED         --JUNE     2000. MACINTOSH
36289C                                      PLACEHOLDER FOR NOW
36290C     UPDATED         --JUNE     2000. PC PRINTER
36291C                                      PLACEHOLDER FOR NOW
36292C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
36293C                                      PLACEHOLDER FOR NOW
36294C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
36295C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
36296C     UPDATED         --FEBRUARY 2006. IMPLEMENT LATEX
36297C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
36298C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
36299C                                      GRAPHICS DEVICES
36300C
36301C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
36302C
36303      CHARACTER*4 ICASE
36304C
36305C-----COMMON----------------------------------------------------------
36306C
36307      INCLUDE 'DPCOGR.INC'
36308      INCLUDE 'DPCOBE.INC'
36309      INCLUDE 'DPCOST.INC'
36310      INCLUDE 'DPCODV.INC'
36311      INCLUDE 'DPCOP2.INC'
36312C
36313C-----START POINT-----------------------------------------------------
36314C
36315      IERRG4='NO'
36316C
36317      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTH')THEN
36318        WRITE(ICOUT,999)
36319  999   FORMAT(1X)
36320        CALL DPWRST('XXX','BUG ')
36321        WRITE(ICOUT,51)
36322   51   FORMAT('***** AT THE BEGINNING OF GRTRTH--')
36323        CALL DPWRST('XXX','BUG ')
36324        WRITE(ICOUT,52)PTHICK,ICASE,IMANUF,IMODEL,IBUGG4
36325   52   FORMAT('PTHICK,ICASE,IMANUF,IMODEL,IBUGG4 = ',G15.7,3(A4,2X),A4)
36326        CALL DPWRST('XXX','BUG ')
36327      ENDIF
36328C
36329C               ************************************************
36330C               **  STEP 0--                                  **
36331C               **  DEFINE THICKNESS                          **
36332C               **  FOR A GENERAL GRAPHICS DEVICE             **
36333C               **  THICKNESS WILL BE SET IN                  **
36334C               **  HARDWARE IF THE DEVICE SUPPORTS           **
36335C               **  THIS CAPABILITY.  OTHERWISE THE           **
36336C               **  FOLLOWING ALGORITHIM IS USED.             **
36337C               **  1)  DRAW A LINE WITH THE REQUESETED COORD.**
36338C               **  2)  PDELTA=(PTHICK/PDEVTH)/2.             **
36339C               **  3)  AINC  = PDELTA/PDEVTH                 **
36340C               **  4)  NINC  = AINC+0.9                      **
36341C               **  5)  JTHICK=NINC                           **
36342C               **      PTHIC2=PDELTA/REAL(NINC)              **
36343C               **  WHERE                                     **
36344C               **      PTHICK IS THE USER REQUESTED THICKNESS**
36345C               **      PDEVTH IS ONE LINE THICKNESS FOR A    **
36346C               **             SPECIFIC DEVICE.               **
36347C               **      "DPDRPL" WILL DRAW THE MIDDLE LINE.   **
36348C               **      IT THEN SPLITS THE REMAINING THICKNESS**
36349C               **      INTO AN "ABOVE" AND "BELOW" PART.     **
36350C               **      NINC IS THE NUMBER OF ADDITIONAL LINES**
36351C               **      REQUIRED (BOTH ABOVE AND BELOW THE    **
36352C               **      INITIAL LINE).  THE DISTANCE IS THEN  **
36353C               **      DIVIDED BY NINC TO GET THE "DELTA"    **
36354C               **      USED BY "DPDRPL", I.E., THE AMOUNT    **
36355C               **      ADDED TO THE COORDINATES TO DRAW THE  **
36356C               **      NEXT LINE.  THE 0.9 IS "FUDGE FACTOR".**
36357C               **      FOR EXAMPLE, ON A TEKTRONIX WITH A    **
36358C               **      LINE THICKNESS OF 0.1, A USER REQUESTED*
36359C               **      THICKNESS OF 0.12 IS REQUIRED BEFORE  **
36360C               **      ADDITIONAL LINES WILL BE DRAWN.       **
36361C               ************************************************
36362C
36363C               ********************************************
36364C               **  STEP 1--                              **
36365C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
36366C               **  AND THE MODEL                         **
36367C               ********************************************
36368C
36369      IF(IMANUF.EQ.'QWIN')THEN
36370        GOTO4700
36371      ELSEIF(IMANUF.EQ.'POST')THEN
36372        GOTO8600
36373      ELSEIF(IMANUF.EQ.'X11 ')THEN
36374        GOTO9600
36375      ELSEIF(IMANUF.EQ.'AQUA')THEN
36376        GOTO13500
36377      ELSEIF(IMANUF.EQ.'GENE')THEN
36378        GOTO3100
36379      ELSEIF(IMANUF.EQ.'SVG ')THEN
36380        GOTO16000
36381      ELSEIF(IMANUF.EQ.'GD  ')THEN
36382        GOTO12000
36383      ELSEIF(IMANUF.EQ.'LATE')THEN
36384        GOTO15000
36385      ELSEIF(IMANUF.EQ.'CAIR')THEN
36386        GOTO17000
36387      ELSEIF(IMANUF.EQ.'D3  ')THEN
36388        GOTO19000
36389      ELSEIF(IMANUF.EQ.'WMF ')THEN
36390        GOTO18000
36391      ELSEIF(IMANUF.EQ.'OPGL')THEN
36392        GOTO4800
36393      ELSEIF(IMANUF.EQ.'TEKT')THEN
36394        GOTO1100
36395      ELSEIF(IMANUF.EQ.'HP')THEN
36396        IF(IMODEL.EQ.'7221')GOTO2100
36397        IF(IMODEL.EQ.'2622')GOTO2300
36398        IF(IMODEL.EQ.'2623')GOTO2300
36399        IF(IMODEL.EQ.'2627')GOTO2300
36400        IF(IMODEL.EQ.'2647')GOTO2300
36401        GOTO2200
36402      ELSEIF(IMANUF.EQ.'LIBP')THEN
36403        GOTO2600
36404      ELSEIF(IMANUF.EQ.'REGI')THEN
36405        GOTO8100
36406      ELSEIF(IMANUF.EQ.'GKS ')THEN
36407        GOTO11000
36408      ELSEIF(IMANUF.EQ.'LAHE')THEN
36409        IF(IMODEL.EQ.'INTE')GOTO4900
36410        IF(IMODEL.EQ.'WINT')GOTO4950
36411        GOTO4600
36412      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
36413        GOTO13000
36414      ELSEIF(IMANUF.EQ.'QUIC')THEN
36415        GOTO9100
36416      ELSEIF(IMANUF.EQ.'CALC')THEN
36417        GOTO4100
36418      ELSEIF(IMANUF.EQ.'ZETA')THEN
36419        GOTO5100
36420      ELSEIF(IMANUF.EQ.'TURB')THEN
36421        GOTO10000
36422      ELSEIF(IMANUF.EQ.'SUN ')THEN
36423        GOTO6600
36424      ENDIF
36425      GOTO9000
36426C
36427C               ******************************************************
36428C               **  STEP 11--                                       **
36429C               **  TREAT THE TEKTRONIX CASE                        **
36430C               ******************************************************
36431C
36432 1100 CONTINUE
36433      PPENTH=PTEKTH
36434      GOTO8000
36435C
36436C               ******************************************************
36437C               **  STEP 21--                                       **
36438C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
36439C               **  (MULTI-COLOR PENPLOTTER)                        **
36440C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
36441C               **             OPERATING AND PROGRAMMING MANUAL,    **
36442C               **             PAGE XX.                             **
36443C               ******************************************************
36444C
36445 2100 CONTINUE
36446      PPENTH=P722TH
36447      GOTO8000
36448C
36449C               ******************************************************
36450C               **  STEP 22--                                       **
36451C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
36452C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
36453C               **  (MULTI-COLOR PENPLOTTERS)                       **
36454C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
36455C               **             OPERATING AND PROGRAMMING MANUAL,    **
36456C               **             PAGE XX, XXX.                        **
36457C               ******************************************************
36458C
36459 2200 CONTINUE
36460      PPENTH=PHPGTH
36461      GOTO8000
36462C
36463C               ******************************************************
36464C               **  STEP 23--                                       **
36465C               **  TREAT THE HEWLETT-PACKARD 2622  CASES           **
36466C               ******************************************************
36467C
36468 2300 CONTINUE
36469      PPENTH=P262TH
36470      GOTO8000
36471C
36472C               ******************************************************
36473C               **  STEP 11--                                       **
36474C               **  TREAT THE UNIX LIBPLOT  CASE                    **
36475C               ******************************************************
36476C
36477 2600 CONTINUE
36478      PTHIC2=PTHICK
36479      JTHICK=0
36480      GOTO9000
36481C
36482C               ******************************************************
36483C               **  STEP 31--                                       **
36484C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
36485C               **  2 CASES: LET THE POST-PROCESSOR DO THE LINE     **
36486C               **           THICKNESS (IPTHSW='OFF') OR HAVE       **
36487C               **           DATAPLOT DO BY DRAWING MULTIPLE LINES  **
36488C               **           IF DATAPLOT DOES IT, THE LINE THICKNESS**
36489C               **           IS TAKEN FROM (PPENSW).                **
36490C               ******************************************************
36491C
36492 3100 CONTINUE
36493      IF(IPTHSW.EQ.'ON')THEN
36494        PPENTH=PPENSW
36495        GOTO8000
36496      ELSE
36497        PTHIC2=PTHICK
36498        JTHICK=0
36499      ENDIF
36500      GOTO9000
36501C
36502C               ******************************************************
36503C               **  STEP 41--                                       **
36504C               **  TREAT THE CALCOMP XXXXXX CASE                   **
36505C               **  (NOT DONE)                                      **
36506C               **  REFERENCE--XX                                   **
36507C               **             XX                                   **
36508C               **             PAGES XX AND XX                      **
36509C               ******************************************************
36510C
36511 4100 CONTINUE
36512      PPENTH=PCALTH
36513      GOTO8000
36514C
36515C               ******************************************************
36516C               **  STEP 46--                                       **
36517C               **  TREAT THE LAHEY   XXXXXX CASE                   **
36518C               **  REFERENCE--Programmer's Reference, Revision C   **
36519C               **             Lahey Computer Systems, January, 1992**
36520C               **             PAGES 51 THRU 65                     **
36521C               ******************************************************
36522C
36523 4600 CONTINUE
36524      PPENTH=PLAHTH
36525      GOTO8000
36526C
36527C               ******************************************************
36528C               **  STEP 47--                                       **
36529C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
36530C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
36531C               ******************************************************
36532C
36533 4700 CONTINUE
36534      PPENTH=100.*(1./ANUMVP)
36535      GOTO8000
36536C
36537C               ******************************************************
36538C               **  STEP 48--                                       **
36539C               **  TREAT THE OPEN-GL DRIVER                        **
36540C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
36541C               ******************************************************
36542C
36543 4800 CONTINUE
36544      GOTO9000
36545C
36546C               ******************************************************
36547C               **  STEP 49--                                       **
36548C               **  TREAT THE LAHEY INTERACTOR CASE                 **
36549C               ******************************************************
36550C
36551 4900 CONTINUE
36552      PPENTH=100.*(1./ANUMVP)
36553      GOTO8000
36554C
36555C               ******************************************************
36556C               **  STEP 49B-                                       **
36557C               **  TREAT THE LAHEY WINTERACTOR CASE                **
36558C               ******************************************************
36559C
36560 4950 CONTINUE
36561      PPENTH=100.*(1./ANUMVP)
36562      GOTO8000
36563C
36564C
36565C               ******************************************************
36566C               **  STEP 51--                                       **
36567C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
36568C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
36569C               **             MODELS 3600SX AND 3653SX             **
36570C               **             PAGES B-0 AND B-1                    **
36571C               ******************************************************
36572C
36573 5100 CONTINUE
36574      PPENTH=PZETTH
36575      GOTO8000
36576C
36577C               ******************************************************
36578C               **  STEP 66--                                       **
36579C               **  TREAT THE SUN       CASE                        **
36580C               ******************************************************
36581C
36582 6600 CONTINUE
36583      PPENTH=PSUNTH
36584      GOTO8000
36585C
36586C               ******************************************************
36587C               **  STEP 81--                                       **
36588C               **  TREAT THE REGIS     CASE                        **
36589C               ******************************************************
36590C
36591 8100 CONTINUE
36592      PPENTH=PREGTH
36593      GOTO8000
36594C
36595C               ******************************************************
36596C               **  STEP 86--                                       **
36597C               **  TREAT THE POSTSCRIPT CASE                       **
36598C               ******************************************************
36599C
36600 8600 CONTINUE
36601C
36602C     THE POSTSCRIPT PROTOCOL LETS THE HARDWARE LINE THICKNESS BE SET
36603C     IN USER COORDINATES.  BASE THE THICKNESS ON THE VERTICAL SIZE.
36604C     TYPICALLY, 8.5*300.  UNLIKE THE QUIC PROTOCOL, POSTSCRIPT SUPPORTS
36605C     RESOLUTIONS OTHER THAN 300 DPI, SO DO NOT "HARD CODE" AS IN THE
36606C     QUIC CASE.
36607C     PTHIC2 WILL BE SET TO THE NUMBER OF PIXELS WIDE THE LINE WILL BE.
36608C     (PTHICK/100.)=(PIXELS/(ANUMVP)) IMPLIES PIXELS=PTHICK*ANUMVP/100.
36609C
36610      ATEMP=PTHICK*ANUMVP/100.
36611      ITEMP=INT(ATEMP+0.5)
36612      IF(ITEMP.LT.1)ITEMP=1
36613      IF(ITEMP.GT.50)ITEMP=50
36614      PTHIC2=REAL(ITEMP)
36615      JTHICK=0
36616      GOTO9000
36617C
36618C               ******************************************************
36619C               **  STEP 91--                                       **
36620C               **  TREAT THE QUIC      CASE                        **
36621C               ******************************************************
36622C
36623 9100 CONTINUE
36624C
36625C     THE QUIC PROTOCOL LETS THE HARDWARE LINE THICKNESS BE SET FROM
36626C     1 TO 31 PIXELS WIDE.  BASE THE THICKNESS ON 8.5 INCHES HEIGHT
36627C     (X300=2,550 PIXELS).  THIS WAY, LINE THICKNESS WILL NOT DEPEND
36628C     ON WHETHER LANDSCAPE OR PORTRAIT MODE IN EFFECT.
36629C     JTHICK IS THE NUMBER OF LOOPS TO DRAW THICKER LINES, SO SET TO 0.
36630C     PTHIC2 WILL BE SET TO THE NUMBER OF PIXELS WIDE THE LINE WILL BE.
36631C     (PTHICK/100.)=(PIXELS/(8.5*300)) IMPLIES PIXELS=PTHICK*(8.5*300)/100.
36632C                                                    =PTHICK*25.5
36633C     NOTE: PIXELS GO IN ODD INCREMENTS ONLY, I.E., 1,3,5,7, .. ,31.
36634C
36635      ATEMP=PTHICK*25.5
36636      ITEMP=INT(ATEMP+0.5)
36637      IF(ITEMP.LT.1)ITEMP=1
36638      IF(ITEMP.GT.31)ITEMP=31
36639      PTHIC2=REAL(ITEMP)
36640      IJUNK=MOD(INT(PTHIC2),2)
36641      IF(IJUNK.EQ.0)PTHIC2=PTHIC2+1.
36642      JTHICK=0
36643      GOTO9000
36644C
36645C               ******************************************************
36646C               **  STEP 96--                                       **
36647C               **  TREAT THE X11        CASE                       **
36648C               **  BASE THICKNESS ON "1000" POINTS SO THAT NUMBER  **
36649C               **  OF PIXELS FOR LINE WIDTH DOES NOT DEPEND ON THE **
36650C               **  PARTICULAR WINDOW OR THE PARTICULAR WORKSTATION **
36651C               **  PTHIC2 IS THE NUMBER OF PIXELS WIDE TO MAKE THE **
36652C               **  LINE.                                           **
36653C               ******************************************************
36654C
36655 9600 CONTINUE
36656      ATEMP=PTHICK*(1000.)/100.
36657      ITEMP=INT(ATEMP+0.5)
36658      IF(ITEMP.LT.1)ITEMP=1
36659      IF(ITEMP.GT.15)ITEMP=15
36660      PTHIC2=REAL(ITEMP)
36661      IJUNK=MOD(ITEMP,2)
36662      IF(IJUNK.EQ.0)PTHIC2=PTHIC2+1.
36663      JTHICK=0
36664      GOTO9000
36665C
36666CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
36667C               *************************************************
36668C               **  STEP 100--                                 **
36669C               **  TREAT THE VGA VIA TURBO-C       CASE       **
36670C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
36671C               **             ENHANCEMENTS, PAGE 83.          **
36672C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
36673C               **             PAGE 321.                       **
36674C               *************************************************
36675C
3667610000 CONTINUE
36677C
36678      ATEMP=PTHICK*ANUMVP/100.
36679      ITEMP=INT(ATEMP+0.5)
36680      IF(ITEMP.LT.1)ITEMP=1
36681      IF(ITEMP.GT.3)ITEMP=3
36682      PTHIC2=REAL(ITEMP)
36683      IJUNK=MOD(ITEMP,2)
36684      IF(IJUNK.EQ.0)PTHIC2=PTHIC2+1.
36685      JTHICK=0
36686      GOTO9000
36687C
36688C               ******************************************************
36689C               **  STEP 110--                                      **
36690C               **  TREAT THE GKS                DRIVER             **
36691C               ******************************************************
36692C
3669311000 CONTINUE
36694      PPENTH=0.1
36695      GOTO8000
36696C
36697C               ******************************************************
36698C               **  STEP 120--                                      **
36699C               **  TREAT THE GD                     DRIVER         **
36700C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
36701C               **  1) JPEG                                         **
36702C               **  2) PNG                                          **
36703C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
36704C               **  BASE THICKNESS ON "1000" POINTS SO THAT NUMBER  **
36705C               **  OF PIXELS FOR LINE WIDTH DOES NOT DEPEND ON THE **
36706C               **  PARTICULAR WINDOW OR THE PARTICULAR WORKSTATION **
36707C               **  PTHIC2 IS THE NUMBER OF PIXELS WIDE TO MAKE THE **
36708C               **  LINE.                                           **
36709C               ******************************************************
36710C
3671112000 CONTINUE
36712      PPENTH=100.*(1./ANUMVP)
36713      GOTO8000
36714C
36715C               ******************************************************
36716C               **  STEP 130--                                      **
36717C               **  TREAT THE ABSOFT                 DRIVER         **
36718C               ******************************************************
36719C
3672013000 CONTINUE
36721      PPENTH=100.*(1./ANUMVP)
36722      GOTO8000
36723C
36724C               ******************************************************
36725C               **  STEP 135--                                      **
36726C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
36727C               ******************************************************
36728C
36729C     NOTE: AQUA LINE THICKNESS SET IN TERMS OF POINT SIZE.  AQUA
36730C           SCREEN SET IN POINT SIZE AS WELL.
36731C
36732C           PUT A CHECK IN FOR ANUMVP IN CASE IT HAS NOT BEEN DEFINED.
36733C
3673413500 CONTINUE
36735      IF(ANUMVP.LT.100 .OR. ANUMVP.GT.10000)THEN
36736        ATEMP=PTHICK*450/100.
36737        IF(ATEMP.LT.0.1)ATEMP=0.1
36738        IF(ATEMP.GT.50.0)ATEMP=50.0
36739      ELSE
36740        ATEMP=PTHICK*ANUMVP/100.
36741        IF(ATEMP.LT.0.1)ATEMP=0.1
36742        IF(ATEMP.GT.50.0)ATEMP=50.0
36743      ENDIF
36744      PTHIC2=ATEMP
36745      JTHICK=0
36746      GOTO9000
36747C
36748C
36749C               ******************************************************
36750C               **  STEP 150--                                      **
36751C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
36752C               ******************************************************
36753C
3675415000 CONTINUE
36755      JTHICK=0
36756      IF(ILATLT.EQ.'HARD')THEN
36757        IF(PTHICK.GE.0.25)THEN
36758          PTHIC2=0.3
36759        ELSEIF(PTHICK.GE.0.15)THEN
36760          PTHIC2=0.2
36761        ELSE
36762          PTHIC2=0.1
36763        ENDIF
36764      ELSE
36765C
36766C       FOR LATEX, ASSUME SINGLE LINE WIDTH IS 1 POINT WIDE.
36767C       SINCE OUR COORDINATE SYSTEM IS SET TO 300 DPI (ONE
36768C       POINT IS 1/72 OF AN INCH), THIS TRANSLATES TO
36769C       ABOUT 4 PIXEL UNITS.
36770C
36771        APIX=2.0
36772        PPENTH=100.*(APIX/ANUMVP)
36773        GOTO8000
36774      ENDIF
36775      GOTO9000
36776C
36777C               ******************************************************
36778C               **  STEP 160--                                      **
36779C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
36780C               ******************************************************
36781C
3678216000 CONTINUE
36783      ATEMP=PTHICK*ANUMVP/100.
36784      ITEMP=INT(ATEMP+0.5)
36785      IF(ITEMP.LT.1)ITEMP=1
36786      IF(ITEMP.GT.50)ITEMP=50
36787      PTHIC2=REAL(ITEMP)
36788      JTHICK=0
36789      GOTO9000
36790C
36791C               ******************************************************
36792C               **  STEP 170--                                      **
36793C               **  TREAT THE CAIRO                          DRIVER **
36794C               ******************************************************
36795C
3679617000 CONTINUE
36797CCCCC PTHIC2=PTHICK*ANUMVP/100.
36798      IF(PTHICK.LT.0.1)THEN
36799        AVAL=0.1
36800      ELSEIF(PTHICK.GT.10.0)THEN
36801        AVAL=10.0
36802      ELSE
36803        AVAL=PTHICK
36804      ENDIF
36805      PTHIC2=AVAL*ANUMVP/100.0
36806      JTHICK=0
36807      GOTO9000
36808C
36809C               ******************************************************
36810C               **  STEP 180--                                      **
36811C               **  TREAT THE WMF                            DRIVER **
36812C               ******************************************************
36813C
3681418000 CONTINUE
36815      GOTO9000
36816C
36817C               ******************************************************
36818C               **  STEP 190--                                      **
36819C               **  TREAT THE D3                             DRIVER **
36820C               ******************************************************
36821C
3682219000 CONTINUE
36823      GOTO9000
36824C
36825 8000 CONTINUE
36826      PDELTA=(PTHICK-PPENTH)/2.
36827      IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)THEN
36828        AINC=PDELTA/PPENTH
36829        NINC=INT(AINC+0.9)
36830        JTHICK=NINC
36831        PTHIC2=PTHICK
36832        IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC)
36833      ELSE
36834        JTHICK=0
36835        PTHIC2=PTHICK
36836      ENDIF
36837      GOTO9000
36838C               *****************
36839C               **  STEP 90--  **
36840C               **  EXIT       **
36841C               *****************
36842C
36843 9000 CONTINUE
36844      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTH')THEN
36845        WRITE(ICOUT,999)
36846        CALL DPWRST('XXX','BUG ')
36847        WRITE(ICOUT,9011)
36848 9011   FORMAT('***** AT THE END       OF GRTRTH--')
36849        CALL DPWRST('XXX','BUG ')
36850        WRITE(ICOUT,9013)PTHICK,JTHICK,PTHIC2,IERRG4
36851 9013   FORMAT('PTHICK,JTHICK,PTHIC2,IERRG4 = ',G15.7,I8,G15.7,2X,A4)
36852        CALL DPWRST('XXX','BUG ')
36853      ENDIF
36854C
36855      RETURN
36856      END
36857      SUBROUTINE GRWRTH(PX1,PY1,ICTEXT,NCTEXT,
36858     1                  IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
36859     1                  JPATT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILL,JCOL,
36860     1                  PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,JSIZE,
36861     1                  JHEIG2,JWIDT2,JVEGA2,JHOGA2,
36862     1                  PHEIG2,PWIDT2,PVEGA2,PHOGA2,
36863     1                  JTHICK,PTHIC2,PXLEC,PXLECG,PYLEC,PYLECG,
36864     1                  ISYMBL,ISPAC,PX99,PY99)
36865C
36866C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE, AND FOR THE STANDARD
36867C              (HARDWARE-GENERATED) FONT, GO TO THE POINT (PX1,PY1) AND
36868C              WRITE OUT THE TEXT STRING (IN A HORIZONTAL DIRECTION)
36869C              CONTAINED IN THE CHARACTER VECTOR ICTEXT(.), WHICH
36870C              CONSISTS OF NCTEXT CHARACTERS.
36871C     NOTE--PX1 AND PY1 ARE IN STANDARDIZED COORDINATES
36872C           THAT IS, EACH IS 0.0 TO 100.0.
36873C     NOTE--THE SUBSECTION    RWIND    HAS BEEN EXTRACTED OUT OF PLOT
36874C           CONTROL COMMON.  THIS (AND GRWRTV) ARE THE ONLY SUBROUTINES
36875C           WHERE THIS SUB-EXTRACTION HAS BEEN DONE.
36876C
36877C     WRITTEN BY--JAMES J. FILLIBEN
36878C                 STATISTICAL ENGINEERING DIVISION
36879C                 INFORMATION TECHNOLOGY LABORATORY
36880C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
36881C                 GAITHERSBURG, MD 20899-8980
36882C                 PHONE--301-975-2855
36883C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
36884C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
36885C     LANGUAGE--ANSI FORTRAN (1977)
36886C     VERSION NUMBER--83.6
36887C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
36888C     UPDATED         --MARCH     1986
36889C     UPDATED         --JANUARY   1989 SUN (BY BILL ANDERSON)
36890C                                      DRIVER OBSOLETE
36891C     UPDATED         --JANUARY   1989 POSTSCRIPT (BY ALAN HECKERT)
36892C     UPDATED         --JANUARY   1989 CGM (BY ALAN HECKERT)
36893C     UPDATED         --JANUARY   1989 QMS QUIC (BY ALAN HECKERT)
36894C     UPDATED         --JANUARY   1989 CALCOMP (BY ALAN HECKERT)
36895C     UPDATED         --JANUARY   1989 ZETA (BY ALAN HECKERT)
36896C     UPDATED         --APRIL     1989 SOFT-CODE BACKSLASH FOR UNIX
36897C     UPDATED         --OCTOBER   1989 RWIND CORRECTION (NELSON HSU)
36898C     UPDATED         --MARCH     1990 X11 (BY ALAN HECKERT)
36899C     UPDATED         --JULY      1990 PACK HP 2622 OUTPUT
36900C     UPDATED         --MARCH     1991 PACK REGIS OUTPUT.  ALSO, REGIS
36901C                                      POSITIONS CHARACTER BELOW RATHER
36902C                                      THAN ABOVE CURRENT POSITION.
36903C     UPDATED         --MAY       1991 RENUMBER TOP BRANCHES (JJF)
36904C     UPDATED         --MAY       1991 VGA/TURBOC DRIVER (JJF)
36905C                                      DRIVER OBSOLETE
36906C     UPDATED         --MAY       1991 FIX POSTSCRIPT CHAR. INDICES.
36907C     UPDATED         --OCTOBER   1991 POSTSCRIPT FONTS (ALAN)
36908C     UPDATED         --SEPTEMBER 1994 FIX TURBO-C SECTION
36909C                                      BAD C-SIDE MULTIPLOTTING (SCALING)
36910C     UPDATED         --JANUARY   1995 FIX FRONT END TIC LABEL JUST.
36911C     UPDATED         --SEPTEMBER 1995 RETROACTIVE JIM/ALAN MERGE
36912C     UPDATED         --SEPTEMBER 1995 FIX TURBO-C SECTION
36913C                                      BAD C-SIDE MULTIPLOTTING (SCALING)
36914C                                      (AGAIN)
36915C     UPDATED         --SEPTEMBER 1995 REFIX TURBO-C SECTION
36916C     UPDATED         --JULY      1996 LAHEY DRIVER (ALAN HECKERT)
36917C                                      OLD, CALCOMP STYLE
36918C                                      DRIVER OBSOLETE
36919C     UPDATED         --OCTOBER   1996. QUICKWIN DRIVER (ALAN)
36920C     UPDATED         --OCTOBER   1996. OPENGL DRIVER (ALAN)
36921C                                      USE BILL MITCHELLS OPENGL
36922C                                      BINDING FOR FORTRAN
36923C     UPDATED         --OCTOBER   1996 GKS (ALAN)
36924C                                      CODED, NOT TESTED
36925C     UPDATED         --OCTOBER   1996 BINARY CGM (ALAN)
36926C                                      PLACEHOLDER FOR NOW
36927C     UPDATED         --OCTOBER   1996 DISPLAY POSTSCRIPT (ALAN)
36928C                                      PLACEHOLDER FOR NOW
36929C     UPDATED         --OCTOBER   1997 LAHEY INTERACTOR (ALAN)
36930C     UPDATED         --DECEMBER  1997 GENERAL CODED FOR GUI
36931C     UPDATED         --JULY      1998 LAHEY WINTERACTOR
36932C     UPDATED         --JUNE      2000 GD (FOR JPEG, PNG, WINDOWS BMP)
36933C     UPDATED         --JUNE      2000 MACINTOSH
36934C                                      PLACEHOLDER FOR NOW
36935C     UPDATED         --JUNE      2000 PC PRINTER
36936C                                      PLACEHOLDER FOR NOW
36937C     UPDATED         --MARCH     2002 LATEX (USING EEPIC)
36938C                                      PLACEHOLDER FOR NOW
36939C     UPDATED         --MARCH     2002 SVG (SCALABLE VECTOR GRAPHICS)
36940C     UPDATED         --MARCH     2005 SUPPORT FOR AQUATERM
36941C     UPDATED         --FEBRUARY  2006 IMPLEMENT LATEX DRIVER
36942C     UPDATED         --MARCH     2008 SUPPORT FOR HARDWARE
36943C                                      CHARACTERS FOR GD DEVICE
36944C     UPDATED         --FEBRUARY  2009 SUBSCRIPT, SUPERSCRIPTS, GREEK
36945C                                      CHARACTERS FOR POSTSCRIPT DEVICE
36946C     UPDATED         --APRIL     2009 IMPLEMENT LIBPLOT DRIVER
36947C     UPDATED         --APRIL     2009 REMOVE PCL, RAMTEK, PRIN, XXXX
36948C                                      DRIVERS (THESE WERE NEVER ACTUALLY
36949C                                      IMPLEMENTED)
36950C     UPDATED         --SEPTEMBER 2009 UPDATE SVG DRIVER
36951C     UPDATED         --FEBRUARY  2012 "<" AND ">" IN STRINGS FOR SVG
36952C     UPDATED         --JULY      2015 ISSUE WITH TEXT FOR SVG DRIVER
36953C                                      WHEN USING THE CHROME BROWSER
36954C     UPDATED         --SEPTEMBER 2015 FIX GREYSCALE COLOR FOR SVG
36955C     UPDATED         --NOVEMBER  2015 FOR SVG, CHECK FOR "&" IN TEXT
36956C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
36957C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
36958C                                      GRAPHICS DEVICES
36959C
36960C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
36961C
36962#ifdef HAVE_WININTERACTER
36963      USE WINTERACTER
36964#endif
36965#ifdef HAVE_INTERACTER
36966      USE INTERACTER
36967#endif
36968#ifdef HAVE_QWIN
36969CQWIN USE DFLIB
36970      USE IFQWIN
36971      TYPE (XYCOORD) XY
36972CCCCC TYPE (FONTINFO) MSFONT
36973      TYPE (WINDOWCONFIG)   DPSCREEN
36974      CHARACTER*4 QWSCRN
36975      COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
36976#endif
36977C
36978      INTEGER IGKSID
36979      INTEGER IGKSWK
36980      INTEGER IGKSTY
36981      COMMON/IGKS/IGKSID,IGKSWK,IGKSTY
36982C
36983      CHARACTER*4 ICTEXT
36984#ifdef HAVE_LIBPLOT
36985      CHARACTER*4 ICTEX2(255)
36986#endif
36987      CHARACTER*4 IPATT
36988      CHARACTER*4 IFONT
36989      CHARACTER*4 ICASE
36990      CHARACTER*4 IJUST
36991      CHARACTER*4 IDIR
36992      CHARACTER*4 IFILL
36993      CHARACTER*4 ICOL
36994      CHARACTER*4 IJUSTH
36995      CHARACTER*4 IJUSTV
36996      CHARACTER*24 ISYMBL
36997      CHARACTER*4 ISPAC
36998      CHARACTER*4 IC4
36999      CHARACTER*1 IC
37000      CHARACTER*1 IC1
37001      CHARACTER*1 IC2
37002      CHARACTER*1 ICARAT
37003      CHARACTER*1 IQUOTE
37004      CHARACTER*2 ICJUNK
37005      CHARACTER*130 ICSTR
37006      CHARACTER*130 ICSTR2
37007      CHARACTER*130 ICSTR3
37008      CHARACTER*4 ISUBN0
37009      CHARACTER*4 IERROR
37010      CHARACTER*4 ISUBRO
37011      CHARACTER*4 ICTEMP
37012C
37013      DIMENSION ICTEXT(*)
37014      INTEGER STRING(130)
37015      INTEGER IADE(80)
37016#ifdef HAVE_LAHEY_CALCOMP
37017      DIMENSION IHOLL(33)
37018      CHARACTER*40 CLAHEY
37019      REAL RLAHEY(7)
37020      INTEGER ILAHEY(9)
37021#endif
37022#ifdef HAVE_CALCOMP
37023      DIMENSION IHOLL2(33)
37024#endif
37025#ifdef HAVE_ZETA
37026      DIMENSION IHOLL3(33)
37027#endif
37028C
37029      PARAMETER (MAXSYM=25)
37030      INTEGER ISTARV(MAXSYM)
37031      INTEGER ISTOPV(MAXSYM)
37032      INTEGER IFONTP(MAXSYM)
37033      REAL SIZEV(MAXSYM)
37034      REAL OFFSEV(MAXSYM)
37035C
37036C-----COMMON----------------------------------------------------------
37037C
37038      INCLUDE 'DPCOPA.INC'
37039      INCLUDE 'DPCOGR.INC'
37040      INCLUDE 'DPCONP.INC'
37041      INCLUDE 'DPCOBE.INC'
37042      INCLUDE 'DPCOST.INC'
37043      INCLUDE 'DPCODV.INC'
37044      INCLUDE 'DPCOF2.INC'
37045      COMMON /RWIND/
37046     1PWXMIN,PWXMAX,PWYMIN,PWYMAX,PWZMIN,PYZMAX,
37047     1WWXMIN,WWXMAX,WWYMIN,WWYMAX,WWZMIN,WWZMAX
37048C
37049      PARAMETER(MAXCLR=89)
37050      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
37051C
37052      INCLUDE 'DPCOCT.INC'
37053      INCLUDE 'DPCOP2.INC'
37054C
37055C-----START POINT-----------------------------------------------------
37056C
37057      IERROR='OFF '
37058      ISUBN0='WRTH'
37059      ISUBRO=ISUBG4
37060      IC4='-999'
37061      IC='-'
37062      IC1='-'
37063      IC2='-'
37064C
37065      NCSTR=(-999)
37066      K=(-999)
37067      K=(-999)
37068      NCTEP2=(-999)
37069      PXDEL=(-999.0)
37070      PYDEL=(-999.0)
37071C
37072      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'WRTH')THEN
37073        WRITE(ICOUT,999)
37074  999   FORMAT(1X)
37075        CALL DPWRST('XXX','BUG ')
37076        WRITE(ICOUT,51)
37077   51   FORMAT('***** AT THE BEGINNING OF GRWRTH--')
37078        CALL DPWRST('XXX','BUG ')
37079        WRITE(ICOUT,53)PX1,PY1,NCTEXT
37080   53   FORMAT('PX1,PY1,NCTEXT = ',2G15.7,I8)
37081        CALL DPWRST('XXX','BUG ')
37082        WRITE(ICOUT,55)(ICTEXT(I),I=1,MIN(25,NCTEXT))
37083   55   FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
37084        CALL DPWRST('XXX','BUG ')
37085        WRITE(ICOUT,56)IGUNIT,JSIZE,IPATT,JPATT
37086   56   FORMAT('IGUNIT,JSIZE,IPATT,JPATT = ',I8,2(2X,A4),I8)
37087        CALL DPWRST('XXX','BUG ')
37088        WRITE(ICOUT,60)IFONT,JFONT,ICASE,JCASE,ISPAC
37089   60   FORMAT('IFONT,JFONT,ICASE,JCASE,ISPAC = ',2(2X,A4,I8),2X,A4)
37090        CALL DPWRST('XXX','BUG ')
37091        WRITE(ICOUT,62)IJUST,JJUST,IDIR,JDIR
37092   62   FORMAT('IJUST,JJUST,IDIR,JDIR= ',2(2X,A4,I8))
37093        CALL DPWRST('XXX','BUG ')
37094        WRITE(ICOUT,64)ANGLE,ANGLE2
37095   64   FORMAT('ANGLE,ANGLE2= ',2G15.7)
37096        CALL DPWRST('XXX','BUG ')
37097        WRITE(ICOUT,65)IFILL,JFILL,ICOL,JCOL
37098   65   FORMAT('IFILL,JFILL,ICOL,JCOL= ',2(2X,A4,I8))
37099        CALL DPWRST('XXX','BUG ')
37100        WRITE(ICOUT,67)PHEIGH,JHEIG2,PHEIG2
37101   67   FORMAT('PHEIGH,JHEIG2,PHEIG2= ',G15.7,I8,G15.7)
37102        CALL DPWRST('XXX','BUG ')
37103        WRITE(ICOUT,68)PWIDTH,JWIDT2,PWIDT2
37104   68   FORMAT('PWIDTH,JWIDT2,PWIDT2= ',G15.7,I8,G15.7)
37105        CALL DPWRST('XXX','BUG ')
37106        WRITE(ICOUT,69)PVEGAP,JVEGA2,PVEGA2
37107   69   FORMAT('PVEGAP,JVEGA2,PVEGA2= ',G15.7,I8,G15.7)
37108        CALL DPWRST('XXX','BUG ')
37109        WRITE(ICOUT,70)PHOGAP,JHOGA2,PHOGA2
37110   70   FORMAT('PHOGAP,JHOGA2,PHOGA2= ',G15.7,I8,G15.7)
37111        CALL DPWRST('XXX','BUG ')
37112        WRITE(ICOUT,71)PTHICK,JTHICK,PTHIC2
37113   71   FORMAT('PTHICK,JTHICK,PTHIC2= ',G15.7,I8,G15.7)
37114        CALL DPWRST('XXX','BUG ')
37115        WRITE(ICOUT,73)PXLEC,PXLECG,PYLEC,PYLECG
37116   73   FORMAT('PXLEC,PXLECG,PYLEC,PYLECG = ',4G15.7)
37117        CALL DPWRST('XXX','BUG ')
37118        WRITE(ICOUT,74)ISYMBL
37119   74   FORMAT('ISYMBL = ',A24)
37120        CALL DPWRST('XXX','BUG ')
37121        WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
37122   79   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',2(A4,2X),A4)
37123        CALL DPWRST('XXX','BUG ')
37124      ENDIF
37125C
37126C               ******************************************
37127C               **  STEP XX--                           **
37128C               **  COMPUTE NEW START POINTS DEPENDING  **
37129C               **  ON THE JUSTIFICATION                **
37130C               ******************************************
37131C
37132      IJUSTH='LEFT'
37133      IJUSTV='BOTT'
37134C
37135      IF(IJUST.EQ.'LEFT')GOTO910
37136      IF(IJUST.EQ.'CENT')GOTO920
37137      IF(IJUST.EQ.'RIGH')GOTO930
37138C
37139      IF(IJUST.EQ.'LJUS')GOTO910
37140      IF(IJUST.EQ.'CJUS')GOTO920
37141      IF(IJUST.EQ.'RJUS')GOTO930
37142C
37143      IF(IJUST.EQ.'LEBO')GOTO910
37144      IF(IJUST.EQ.'CEBO')GOTO920
37145      IF(IJUST.EQ.'RIBO')GOTO930
37146C
37147      IF(IJUST.EQ.'LECE')GOTO940
37148      IF(IJUST.EQ.'CECE')GOTO950
37149      IF(IJUST.EQ.'RICE')GOTO960
37150C
37151      IF(IJUST.EQ.'LETO')GOTO970
37152      IF(IJUST.EQ.'CETO')GOTO980
37153      IF(IJUST.EQ.'RITO')GOTO990
37154C
37155      GOTO910
37156C
37157  910 CONTINUE
37158      PXINC=0.0
37159      PYINC=0.0
37160      IJUSTH='LEFT'
37161      IJUSTV='BOTT'
37162      GOTO995
37163C
37164  920 CONTINUE
37165      PXINC=PXLEC/2.0
37166      PYINC=0.0
37167      IJUSTH='CENT'
37168      IJUSTV='BOTT'
37169      GOTO995
37170C
37171  930 CONTINUE
37172      PXINC=PXLEC
37173      PYINC=0.0
37174      IJUSTH='RIGH'
37175      IJUSTV='BOTT'
37176      GOTO995
37177C
37178  940 CONTINUE
37179      PXINC=0.0
37180      PYINC=PYLEC/2.0
37181      IJUSTH='LEFT'
37182      IJUSTV='CENT'
37183      GOTO995
37184C
37185  950 CONTINUE
37186      PXINC=PXLEC/2.0
37187      PYINC=PYLEC/2.0
37188      IJUSTH='CENT'
37189      IJUSTV='CENT'
37190      GOTO995
37191C
37192  960 CONTINUE
37193      PXINC=PXLEC
37194      PYINC=PYLEC/2.0
37195      IJUSTH='RIGH'
37196      IJUSTV='CENT'
37197      GOTO995
37198C
37199  970 CONTINUE
37200      PXINC=0.0
37201      PYINC=PYLEC
37202      IJUSTH='LEFT'
37203      IJUSTV='TOP '
37204      GOTO995
37205C
37206  980 CONTINUE
37207      PXINC=PXLEC/2.0
37208      PYINC=PYLEC
37209      IJUSTH='CENT'
37210      IJUSTV='TOP '
37211      GOTO995
37212C
37213  990 CONTINUE
37214      PXINC=PXLEC
37215      PYINC=PYLEC
37216      IJUSTH='RIGH'
37217      IJUSTV='TOP '
37218      GOTO995
37219C
37220  995 CONTINUE
37221      PXINC2=PXINC*(100.0/(PWXMAX-PWXMIN))
37222      PYINC2=PYINC*(100.0/(PWYMAX-PWYMIN))
37223      PX1P=PX1-PXINC2
37224      PY1P=PY1-PYINC2
37225C
37226C               *************************
37227C               **  STEP XX--          **
37228C               **  COMPUTE END POINT  **
37229C               *************************
37230C
37231      ANCTEX=NCTEXT
37232      PX99=PX1P+ANCTEX*(PWIDT2+PHOGA2)
37233      PY99=PY1P
37234C
37235C               ******************************************************
37236C               **  STEP 1--                                        **
37237C               **  BRANCH ACCORDING TO THE MANUFACTURER            **
37238C               **  AND THE MODEL                                   **
37239C               ******************************************************
37240C
37241      IF(IMANUF.EQ.'QWIN')THEN
37242        GOTO4700
37243      ELSEIF(IMANUF.EQ.'POST')THEN
37244        GOTO8600
37245      ELSEIF(IMANUF.EQ.'X11 ')THEN
37246        GOTO9600
37247      ELSEIF(IMANUF.EQ.'AQUA')THEN
37248        GOTO13500
37249      ELSEIF(IMANUF.EQ.'GENE')THEN
37250        IF(IMODEL.EQ.'CODE')GOTO3200
37251        IF(IMODEL.EQ.'CGM')GOTO3300
37252        IF(IMODEL.EQ.'CGMB')GOTO3400
37253        GOTO3100
37254      ELSEIF(IMANUF.EQ.'SVG ')THEN
37255        GOTO16000
37256      ELSEIF(IMANUF.EQ.'GD  ')THEN
37257        GOTO12000
37258      ELSEIF(IMANUF.EQ.'LATE')THEN
37259        GOTO15000
37260      ELSEIF(IMANUF.EQ.'CAIR')THEN
37261        GOTO17000
37262      ELSEIF(IMANUF.EQ.'D3  ')THEN
37263        GOTO19000
37264      ELSEIF(IMANUF.EQ.'WMF ')THEN
37265        GOTO18000
37266      ELSEIF(IMANUF.EQ.'OPGL')THEN
37267        GOTO4800
37268      ELSEIF(IMANUF.EQ.'TEKT')THEN
37269        GOTO1100
37270      ELSEIF(IMANUF.EQ.'HP')THEN
37271        IF(IMODEL.EQ.'7221')GOTO2100
37272        IF(IMODEL.EQ.'2622')GOTO2300
37273        IF(IMODEL.EQ.'2623')GOTO2300
37274        IF(IMODEL.EQ.'2627')GOTO2300
37275        IF(IMODEL.EQ.'2647')GOTO2300
37276        GOTO2200
37277      ELSEIF(IMANUF.EQ.'LIBP')THEN
37278        GOTO2600
37279      ELSEIF(IMANUF.EQ.'REGI')THEN
37280        GOTO8100
37281      ELSEIF(IMANUF.EQ.'GKS ')THEN
37282        GOTO11000
37283      ELSEIF(IMANUF.EQ.'LAHE')THEN
37284        IF(IMODEL.EQ.'INTE')GOTO4900
37285        IF(IMODEL.EQ.'WINT')GOTO4950
37286        GOTO4600
37287      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
37288        GOTO13000
37289      ELSEIF(IMANUF.EQ.'QUIC')THEN
37290        GOTO9100
37291      ELSEIF(IMANUF.EQ.'CALC')THEN
37292        GOTO4100
37293      ELSEIF(IMANUF.EQ.'ZETA')THEN
37294        GOTO5100
37295      ELSEIF(IMANUF.EQ.'TURB')THEN
37296        GOTO10000
37297      ELSEIF(IMANUF.EQ.'SUN ')THEN
37298        GOTO6600
37299      ENDIF
37300      GOTO9000
37301C
37302C               ******************************************************
37303C               **  STEP 11--                                       **
37304C               **  TREAT THE TEKTRONIX 4014 (ETC.) CASE            **
37305C               ******************************************************
37306C
37307 1100 CONTINUE
37308      IFACTO=4
37309      IF(NUMVPP.GE.3000)IFACTO=1
37310      ICSTR(1:1)=IGSC
37311      NCSTR=1
37312      CALL GRTRSD(PX1P,PY1P,IX1P,IY1P,ISUBN0)
37313      CALL TKTRPT(IX1P,IY1P,IFACTO,ICSTR,NCSTR,ISUBN0)
37314      NCSTR=NCSTR+1
37315      ICSTR(NCSTR:NCSTR)=IUSC
37316      DO1110I=1,NCTEXT
37317        NCSTR=NCSTR+1
37318        ICTEMP=ICTEXT(I)
37319        ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
37320 1110 CONTINUE
37321      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
37322      GOTO9000
37323C
37324C               ******************************************************
37325C               **  STEP 21--                                       **
37326C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
37327C               **  (MULTI-COLOR PENPLOTTER)                        **
37328C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
37329C               **  USE THE LOWER CASE P (= MOVE) INSTRUCTION       **
37330C               **  AND PACKED BINARY COORDINATES,                  **
37331C               **  AND THE TILDA SINGLE (RT-LEFT) QUOTE (= INVOKE  **
37332C               **   LABEL MODE) I AND THE DESIRED TEXT STRING,     **
37333C               **  AND ETX TO DENOTE THE END OF TEXT STRING,       **
37334C               **  (WITH TRAILING RIGHT CURLY BRACKET WHICH IS THE **
37335C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
37336C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
37337C               **             OPERATING AND PROGRAMMING MANUAL,    **
37338C               **             PAGE 80-85, 253-254.                 **
37339C               **             PAGE 111 AND 112.                    **
37340C               ******************************************************
37341C
37342 2100 CONTINUE
37343      ICSTR(1:1)='p'
37344      NCSTR=1
37345      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
37346      CALL HPTRPT(IX,IY,ICSTR,NCSTR,ISUBN0)
37347      NCSTR=NCSTR+1
37348      ICSTR(NCSTR:NCSTR)='}'
37349      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
37350C
37351      ICSTR(1:2)='~'''
37352      NCSTR=2
37353      DO2112J=1,NCTEXT
37354        K=J+NCSTR
37355        ICTEMP=ICTEXT(J)
37356        ICSTR(K:K)=ICTEMP(1:1)
37357 2112 CONTINUE
37358      NCSTR=K
37359      NCSTR=NCSTR+1
37360      ICSTR(NCSTR:NCSTR)=IETXC
37361      NCSTR=NCSTR+1
37362      ICSTR(NCSTR:NCSTR)='}'
37363      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
37364      GOTO9000
37365C
37366C               ******************************************************
37367C               **  STEP 22--                                       **
37368C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
37369C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
37370C               **  (MULTI-COLOR PENPLOTTERS)                       **
37371C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
37372C               **  USE THE PU (= PEN UP) INSTRUCTION               **
37373C               **  AND THE PA (= PLOT ABSOLUTE) INSTRUCTION        **
37374C               **  ALONG WITH INTEGER COORDINATES,                 **
37375C               **  AND THE LB (= LABEL) INSTRUCTION                **
37376C               **  AND THE DESIRED TEXT STRING,                    **
37377C               **  AND ETX TO DENOTE THE END OF TEXT STRING,       **
37378C               **  (WITH   TRAILING SEMI-COLONS WHICH ARE THE      **
37379C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
37380C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
37381C               **             OPERATING AND PROGRAMMING MANUAL,    **
37382C               **             PAGE 62, 143.                        **
37383C               **             PAGE 65-67, 143.                     **
37384C               **             PAGE 75, 141.                        **
37385C               ******************************************************
37386C
37387 2200 CONTINUE
37388      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
37389      ICSTR(1:5)='PU;PA'
37390      NCSTR=5
37391      NCHTOT=5
37392      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
37393      ICSTR(11:11)=','
37394      NCSTR=11
37395      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
37396      ICSTR(17:17)=';'
37397      NCSTR=17
37398      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
37399C
37400      NCTEP1=NCTEXT+1
37401      NCTEP2=NCTEXT+2
37402      ICTEXT(NCTEP1)=IETXC
37403      ICTEXT(NCTEP2)=';'
37404      ICSTR(1:2)='LB'
37405      NCSTR=2
37406      DO2212J=1,NCTEP2
37407      K=J+NCSTR
37408      ICSTR(K:K)=ICTEXT(J)
37409 2212 CONTINUE
37410      NCSTR=K
37411      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
37412C
37413      GOTO9000
37414C
37415C               **********************************************************
37416C               **  STEP 23--                                           **
37417C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
37418C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
37419C               **  (MONOCHROME DISPLAY TERMINALS)                      **
37420C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
37421C               **             REFERENCE MANUAL,                        **
37422C               **             PAGE 10-12, 10-13, 10-21.                **
37423C               **********************************************************
37424C
37425C  JULY, 1990.  PACK OUTPUT ONTO 1 LINE.
37426C
37427 2300 CONTINUE
37428      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
37429      ICSTR(1:1)=IESCC
37430      ICSTR(2:4)='*pa'
37431      NCSTR=4
37432      NCHTOT=5
37433      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
37434      ICSTR(10:10)=','
37435      NCSTR=10
37436      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
37437      ICSTR(16:16)='Z'
37438      NCSTR=16
37439C
37440      NCTEP1=NCTEXT+1
37441      ICTEXT(NCTEP1)=ICRC
37442      ICSTR(17:17)=IESCC
37443      ICSTR(18:19)='*l'
37444      NCSTR=19
37445      DO2312J=1,NCTEP1
37446        K=J+NCSTR
37447        ICSTR(K:K)=ICTEXT(J)
37448 2312 CONTINUE
37449      NCSTR=K
37450      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
37451C
37452      GOTO9000
37453C
37454C               **********************************************************
37455C               **  STEP 26--                                           **
37456C               **  TREAT THE UNIX LIBPLOT            CASE              **
37457C               **********************************************************
37458C
37459 2600 CONTINUE
37460C
37461#ifdef HAVE_LIBPLOT
37462      CALL LIBPTR(ICTEXT,NCTEXT,ICTEX2,NCTEX2,ICASE,ISUBRO,IBUGG4)
37463      DO2605I=1,NCTEX2
37464        IC1=ICTEX2(I)(1:1)
37465        CALL DPCOAN(IC1,IJUNK)
37466        STRING(I)=IJUNK
37467 2605 CONTINUE
37468#endif
37469      STRING(NCTEX2+1)=0
37470C
37471      ILAST=80
37472      DO2610I=80,1,-1
37473        ILAST=I
37474        IF(ILPLFN(I:I).NE.' ')GOTO2619
37475 2610 CONTINUE
37476 2619 CONTINUE
37477      DO2620I=1,ILAST
37478        CALL DPCOAN(ILPLFN(I:I),IJUNK)
37479        IADE(I)=IJUNK
37480 2620 CONTINUE
37481      IADE(ILAST+1)=0
37482C
37483      IFONTH=0
37484      IFONTV=0
37485      IF(IJUST.EQ.'LEFT')IFONTH=0
37486      IF(IJUST.EQ.'CENT')IFONTH=1
37487      IF(IJUST.EQ.'RIGH')IFONTH=2
37488      IF(IJUST.EQ.'LJUS')IFONTH=0
37489      IF(IJUST.EQ.'CJUS')IFONTH=1
37490      IF(IJUST.EQ.'RJUS')IFONTH=2
37491      IF(IJUST.EQ.'LEBO')IFONTH=0
37492      IF(IJUST.EQ.'CEBO')IFONTH=1
37493      IF(IJUST.EQ.'RIBO')IFONTH=2
37494      IF(IJUST.EQ.'LECE')IFONTH=0
37495      IF(IJUST.EQ.'CECE')IFONTH=1
37496      IF(IJUST.EQ.'RICE')IFONTH=2
37497      IF(IJUST.EQ.'LETO')IFONTH=0
37498      IF(IJUST.EQ.'CETO')IFONTH=1
37499      IF(IJUST.EQ.'RITO')IFONTH=2
37500      IF(IJUST.EQ.'LEFT')IFONTV=1
37501      IF(IJUST.EQ.'CENT')IFONTV=1
37502      IF(IJUST.EQ.'RIGH')IFONTV=1
37503      IF(IJUST.EQ.'LJUS')IFONTV=1
37504      IF(IJUST.EQ.'CJUS')IFONTV=1
37505      IF(IJUST.EQ.'RJUS')IFONTV=1
37506      IF(IJUST.EQ.'LEBO')IFONTV=1
37507      IF(IJUST.EQ.'CEBO')IFONTV=1
37508      IF(IJUST.EQ.'RIBO')IFONTV=1
37509      IF(IJUST.EQ.'LECE')IFONTV=0
37510      IF(IJUST.EQ.'CECE')IFONTV=0
37511      IF(IJUST.EQ.'RICE')IFONTV=0
37512      IF(IJUST.EQ.'LETO')IFONTV=2
37513      IF(IJUST.EQ.'CETO')IFONTV=2
37514      IF(IJUST.EQ.'RITO')IFONTV=2
37515      IERR=0
37516C
37517#ifdef HAVE_LIBPLOT
37518      CALL PLTXTH(IADE,STRING,DBLE(PX1),DBLE(PY1),IFONTH,IFONTV,
37519     1            DBLE(PHEIG2),IERR)
37520#endif
37521C
37522      GOTO9000
37523C
37524C               ******************************************************
37525C               **  STEP 31--                                       **
37526C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
37527C               ******************************************************
37528C
37529 3100 CONTINUE
37530C     JANUARY, 1988: SWITCH TO LET DATAPLOT DO THE JUSTIFICATION OR
37531C                    LET THE POST PROCESOR DO IT
37532CCCCC THE FOLLOWING 2 LINES WAS CHANGED     JANUARY 1995
37533CCCCC TO FIX THE TIC JUSTIFICATION PROBLEM  JANUARY 1995
37534CCCCC IF(IJUSSW.EQ.'ON')PX1P=PX1
37535CCCCC IF(IJUSSW.EQ.'ON')PY1P=PY1
37536      PX1P=PX1
37537      PY1P=PY1
37538      ICSTR(1:8)='MOVE TO '
37539      NCSTR=8
37540      NCHTOT=10
37541      NCHDEC=5
37542      CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
37543      PX1P=AX
37544      PY1P=AY
37545      CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
37546      ICSTR(19:20)='  '
37547      NCSTR=20
37548      CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
37549      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
37550      IF(NCTEXT.GT.0)THEN
37551        ICSTR(1:11)='WRITE TEXT '
37552        NCSTR=11
37553        K=0
37554        DO3112J=1,NCTEXT
37555          K=J+NCSTR
37556          ICSTR(K:K)=ICTEXT(J)
37557 3112   CONTINUE
37558        NCSTR=K
37559        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
37560      ENDIF
37561      GOTO9000
37562C
37563C               ***************************************************************
37564C               **  STEP 32--                                                **
37565C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
37566C               ***************************************************************
37567C
37568 3200 CONTINUE
37569C     JANUARY, 1988: SWITCH TO LET DATAPLOT DO THE JUSTIFICATION OR
37570C     LET THE POST PROCESOR DO IT
37571C     DECEMBER 1997.  SLIGHTLY DIFFERENT CODING FOR GUI.
37572CCCCC THE FOLLOWING 2 LINES WAS CHANGED     JANUARY 1995
37573CCCCC TO FIX THE TIC JUSTIFICATION PROBLEM  JANUARY 1995
37574CCCCC IF(IJUSSW.EQ.'ON')PX1P=PX1
37575CCCCC IF(IJUSSW.EQ.'ON')PY1P=PY1
37576      IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')THEN
37577        CALL GRTRSA(PX1,PY1,AX,AY,ISUBN0)
37578        IPXTMP=INT(AX*10.**IGENFA+0.5)
37579        IPYTMP=INT(AY*10.**IGENFA+0.5)
37580        ICSTR(1:2)='M '
37581        NCSTR=2
37582        NCHTOT=IGENFA+3
37583        CALL GRTRIN(IPXTMP,NCHTOT,ICSTR,NCSTR)
37584        NCSTR=NCSTR+1
37585        ICSTR(NCSTR:NCSTR)=' '
37586        CALL GRTRIN(IPYTMP,NCHTOT,ICSTR,NCSTR)
37587        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
37588      ELSE
37589        PX1P=PX1
37590        PY1P=PY1
37591        ICSTR(1:5)='MOTO '
37592        NCSTR=5
37593        NCHTOT=10
37594        NCHDEC=5
37595        CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
37596        PX1P=AX
37597        PY1P=AY
37598        CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
37599        ICSTR(16:17)='  '
37600        NCSTR=17
37601        CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
37602        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
37603      ENDIF
37604C
37605      IF(NCTEXT.GT.0)THEN
37606        ICSTR(1:5)='WRTE '
37607        NCSTR=5
37608        K=0
37609        DO3212J=1,NCTEXT
37610          K=J+NCSTR
37611          ICSTR(K:K)=ICTEXT(J)
37612 3212   CONTINUE
37613        NCSTR=K
37614        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
37615      ENDIF
37616      GOTO9000
37617C
37618C               ***************************************************************
37619C               **  STEP 33--                                                **
37620C               **  TREAT THE CGM                                CASE        **
37621C               ***************************************************************
37622C
37623 3300 CONTINUE
37624C     JANUARY, 1988: SWITCH TO LET DATAPLOT DO THE JUSTIFICATION OR
37625C                    LET THE POST PROCESOR DO IT
37626      IF(NCTEXT.LE.0)GOTO9000
37627C
37628CCCCC THE FOLLOWING 2 LINES WAS CHANGED     JANUARY 1995
37629CCCCC TO FIX THE TIC JUSTIFICATION PROBLEM  JANUARY 1995
37630CCCCC IF(IJUSSW.EQ.'ON')PX1P=PX1
37631CCCCC IF(IJUSSW.EQ.'ON')PY1P=PY1
37632      PX1P=PX1
37633      PY1P=PY1
37634      CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
37635      PX1P=AX
37636      PY1P=AY
37637      ICSTR(1:6)='TEXT ('
37638      NCSTR=6
37639      NCHTOT=10
37640      NCHDEC=5
37641      CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
37642      ICSTR(17:17)=','
37643      NCSTR=17
37644      CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
37645      ICSTR(28:34)=') FINAL'
37646      NCSTR=34
37647      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
37648      ICSTR(1:1)='"'
37649      NCSTR=1
37650      K=0
37651      DO3312J=1,NCTEXT
37652        K=J+NCSTR
37653        ICSTR(K:K)=ICTEXT(J)
37654 3312 CONTINUE
37655      K=K+1
37656      ICSTR(K:K)='"'
37657      K=K+1
37658      ICSTR(K:K)=';'
37659      NCSTR=K
37660      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
37661      GOTO9000
37662C
37663C               ***************************************************
37664C               **  STEP 34--                                    **
37665C               **  TREAT THE CGM (BINARY)                 CASE  **
37666C               ***************************************************
37667C
37668 3400 CONTINUE
37669      GOTO9000
37670C
37671C               ******************************************************
37672C               **  STEP 41--                                       **
37673C               **  TREAT THE CALCOMP XXXXXX CASE                   **
37674C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
37675C               **  WRITE OUT AN XXXXXXXXXX                         **
37676C               **  USE CALCOMP LIBRARY ROUTINE SYMBOL              **
37677C               **  REFERENCE--FUNDAMENTAL PLOTTING ROUTINES        **
37678C               **             FORTRAN REFERENCE MANUAL - NICOLET   **
37679C               **             PAGES 2-7 (1984 EDITION)             **
37680C               ******************************************************
37681C
37682 4100 CONTINUE
37683#ifdef HAVE_CALCOMP
37684      CALL CALCPT(PX1P,PY1P,AX1,AY1,ISUBN0)
37685      DO4112J=1,NCTEXT
37686        ICSTR(J:J)=ICTEXT(J)
37687 4112 CONTINUE
37688      ANGLE=0.
37689      AXTEMP=0.
37690      CALL CALCPT(AXTEMP,PHEIG2,AYTMP2,HEIGHT,ISUBN0)
37691      CALL CALCTR(ICSTR,IHOLL2,NCTEXT)
37692#endif
37693      GOTO9000
37694C
37695C               ******************************************************
37696C               **  STEP 46--                                       **
37697C               **  TREAT THE LAHEY   XXXXXX CASE                   **
37698C               **  REFERENCE--Programmer's Reference, Revision C   **
37699C               **             Lahey Computer Systems, January, 1992**
37700C               **             PAGES 51 THRU 65                     **
37701C               ******************************************************
37702C
37703 4600 CONTINUE
37704#ifdef HAVE_LAHEY_CALCOMP
37705      ICSTR=' '
37706      CALL CALCPT(PX1,PY1,AX1,AY1,ISUBN0)
37707      DO4612J=1,NCTEXT
37708        ICSTR(J:J)=ICTEXT(J)
37709 4612 CONTINUE
37710      CALL GRINFO(ILAHEY,RLAHEY,CLAHEY)
37711      ICOLMN=INT(REAL(ILAHEY(8))*(AX1*RLAHEY(1)/11.0)+0.5)
37712      IF(IJUSTH.EQ.'RIGH')THEN
37713        NSHIFT=NCTEXT
37714      ELSEIF(IJUSTH.EQ.'CENT')THEN
37715        NSHIFT=NCTEXT/2
37716      ELSE
37717        NSHIFT=0
37718      ENDIF
37719      ICOLMN=ICOLMN-NSHIFT
37720      IF(ICOLMN.LT.1)ICOLMN=1
37721      IF(ICOLMN.GT.ILAHEY(8))ICOLMN=ILAHEY(8)
37722      ILINE=INT(REAL(ILAHEY(9))*(RLAHEY(1)*(8.5-AY1)/8.5)+0.5)
37723      IF(IJUSTV.EQ.'TOP')THEN
37724        NSHIFT=1
37725      ELSEIF(IJUSTV.EQ.'CENT')THEN
37726        NSHIFT=1
37727      ELSE
37728        NSHIFT=0
37729      ENDIF
37730      ILINE=ILINE-NSHIFT
37731      IF(ILINE.LT.1)ILINE=1
37732      IF(ILINE.GT.ILAHEY(9))ILINE=ILAHEY(9)
37733      CALL GTEXT(ILINE,ICOLMN,ICSTR(1:NCTEXT))
37734#endif
37735      GOTO9000
37736C
37737C               ******************************************************
37738C               **  STEP 47--                                       **
37739C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
37740C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
37741C               ******************************************************
37742C
37743 4700 CONTINUE
37744#ifdef HAVE_QWIN
37745      ICSTR=' '
37746      DO4712J=1,NCTEXT
37747        ICSTR(J:J)=ICTEXT(J)
37748 4712 CONTINUE
37749      CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
37750      IF(IJUSTH.EQ.'LEFT')THEN
37751        IXINC=0
37752      ELSEIF(IJUSTH.EQ.'CENT')THEN
37753        IXINC=GETGTEXTEXTENT(ICSTR(1:NCTEXT))/2
37754      ELSEIF(IJUSTH.EQ.'RIGH')THEN
37755        IXINC=GETGTEXTEXTENT(ICSTR(1:NCTEXT))
37756      ELSE
37757        IXINC=0
37758      ENDIF
37759      IF(IJUSTV.EQ.'TOP ')THEN
37760        IYINC=0
37761      ELSEIF(IJUSTV.EQ.'CENT')THEN
37762        IYINC=JHEIG2/2
37763      ELSEIF(IJUSTV.EQ.'BOTT')THEN
37764        IYINC=JHEIG2
37765      ELSE
37766        IYINC=0
37767      ENDIF
37768      CALL MOVETO(INT2(IX1-IXINC),INT2(IY1-IYINC),XY)
37769      CALL OUTGTEXT(ICSTR(1:NCTEXT))
37770#endif
37771      GOTO9000
37772C
37773C               ******************************************************
37774C               **  STEP 48--                                       **
37775C               **  TREAT THE OPEN-GL DRIVER                        **
37776C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
37777C               ******************************************************
37778C
37779 4800 CONTINUE
37780#ifdef HAVE_OPEN_GL
37781      IF(IOPGOF.EQ.'OFF')GOTO9000
37782C
37783      DO4805I=1,NCTEXT
37784        IC1=ICTEXT(I)(1:1)
37785        CALL DPCOAN(IC1,IJUNK)
37786        STRING(I)=IJUNK
37787 4805 CONTINUE
37788      STRING(NCTEXT+1)=0
37789C
37790      ILAST=80
37791      DO4810I=80,1,-1
37792        ILAST=I
37793        IF(IX11FN(I:I).NE.' ')GOTO4819
37794 4810 CONTINUE
37795 4819 CONTINUE
37796      DO4820I=1,ILAST
37797        CALL DPCOAN(IX11FN(I:I),IJUNK)
37798        IADE(I)=IJUNK
37799 4820 CONTINUE
37800      IADE(ILAST+1)=0
37801C
37802      CALL GLTATT(IADE,IXERR)
37803      IF(IXERR.EQ.1) THEN
37804        WRITE(ICOUT,4821)
37805 4821   FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE CURRENT FONT')
37806        CALL DPWRST('XXX','BUG ')
37807      ELSEIF(IXERR.EQ.2)THEN
37808        WRITE(ICOUT,4822)
37809 4822   FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE DEFAULT FONT')
37810        CALL DPWRST('XXX','BUG ')
37811      END IF
37812C
37813      IFONTH=0
37814      IFONTV=0
37815      IF(IJUST.EQ.'LEFT')IFONTH=0
37816      IF(IJUST.EQ.'CENT')IFONTH=1
37817      IF(IJUST.EQ.'RIGH')IFONTH=2
37818      IF(IJUST.EQ.'LJUS')IFONTH=0
37819      IF(IJUST.EQ.'CJUS')IFONTH=1
37820      IF(IJUST.EQ.'RJUS')IFONTH=2
37821      IF(IJUST.EQ.'LEBO')IFONTH=0
37822      IF(IJUST.EQ.'CEBO')IFONTH=1
37823      IF(IJUST.EQ.'RIBO')IFONTH=2
37824      IF(IJUST.EQ.'LECE')IFONTH=0
37825      IF(IJUST.EQ.'CECE')IFONTH=1
37826      IF(IJUST.EQ.'RICE')IFONTH=2
37827      IF(IJUST.EQ.'LETO')IFONTH=0
37828      IF(IJUST.EQ.'CETO')IFONTH=1
37829      IF(IJUST.EQ.'RITO')IFONTH=2
37830      IF(IJUST.EQ.'LEFT')IFONTV=1
37831      IF(IJUST.EQ.'CENT')IFONTV=1
37832      IF(IJUST.EQ.'RIGH')IFONTV=1
37833      IF(IJUST.EQ.'LJUS')IFONTV=1
37834      IF(IJUST.EQ.'CJUS')IFONTV=1
37835      IF(IJUST.EQ.'RJUS')IFONTV=1
37836      IF(IJUST.EQ.'LEBO')IFONTV=1
37837      IF(IJUST.EQ.'CEBO')IFONTV=1
37838      IF(IJUST.EQ.'RIBO')IFONTV=1
37839      IF(IJUST.EQ.'LECE')IFONTV=0
37840      IF(IJUST.EQ.'CECE')IFONTV=0
37841      IF(IJUST.EQ.'RICE')IFONTV=0
37842      IF(IJUST.EQ.'LETO')IFONTV=2
37843      IF(IJUST.EQ.'CETO')IFONTV=2
37844      IF(IJUST.EQ.'RITO')IFONTV=2
37845      IXERR=0
37846      IX1=INT(PX1+0.5)
37847      IY1=INT(PY1+0.5)
37848      CALL GLTEXH(STRING,IX1,IY1,IFONTH,IFONTV,IXERR)
37849#endif
37850      GOTO9000
37851C
37852C               ******************************************************
37853C               **  STEP 49--                                       **
37854C               **  TREAT THE LAHEY INTERACTOR CASE                 **
37855C               ******************************************************
37856C
37857 4900 CONTINUE
37858      GOTO9000
37859C
37860C               ******************************************************
37861C               **  STEP 49B-                                       **
37862C               **  TREAT THE LAHEY WINTERACTOR CASE                **
37863C               ******************************************************
37864C
37865 4950 CONTINUE
37866#ifdef HAVE_WININTERACTER
37867      ICSTR=' '
37868      DO4952J=1,NCTEXT
37869        ICSTR(J:J)=ICTEXT(J)
37870 4952 CONTINUE
37871      IF(IJUSTH.EQ.'LEFT')THEN
37872        CALL IGrCharJustify('L')
37873      ELSEIF(IJUSTH.EQ.'CENT')THEN
37874        CALL IGrCharJustify('C')
37875      ELSEIF(IJUSTH.EQ.'RIGH')THEN
37876        CALL IGrCharJustify('R')
37877      ELSE
37878        CALL IGrCharJustify('C')
37879      ENDIF
37880      PYINC=0.0
37881      IF(IJUSTV.EQ.'TOP')THEN
37882        PYINC=InfoGraphics(4)
37883      ELSEIF(IJUSTV.EQ.'CENT')THEN
37884        PYINC=InfoGraphics(4)/2.0
37885      ELSEIF(IJUSTV.EQ.'BOTT')THEN
37886        PYINC=0.0
37887      ELSE
37888        PYINC=InfoGraphics(4)/2.0
37889      ENDIF
37890      CALL IGrCharOut(PX1,PY1+PYINC,ICSTR(1:NCTEXT))
37891#endif
37892      GOTO9000
37893C
37894C
37895C               ******************************************************
37896C               **  STEP 51--                                       **
37897C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
37898C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
37899C               **  USE THE 1 OP CODE (= MOVE)                      **
37900C               **  ALONG WITH COORDINATES,                         **
37901C               **  USE THE 3 OP CODE (= CHARACTER STRING)          **
37902C               **  ALONG WITH RELATIVE COOR                        **
37903C               **  ALONG WITH NUMBER OF CHAR (= 1)                 **
37904C               **  ALONG WITH CONVERTED CHAR STRING                **
37905C               **  (2 CONVERTED CHAR FOR EVERY SINGLE CHAR).       **
37906C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
37907C               **             MODELS 3600SX AND 3653SX             **
37908C               **             PAGES B-0 , B-1, AND E-1             **
37909C               **  REFERENCE--ZETA FORTRAN REFERENCE MANUAL        **
37910C               **             PAGE A-2                             **
37911C               **  USE CALCOMP LIBRARY (MARCH,1988)                **
37912C               ******************************************************
37913C
37914 5100 CONTINUE
37915#ifdef HAVE_ZETA
37916      CALL CALCPT(PX1P,PY1P,AX1,AY1,ISUBN0)
37917      DO5112J=1,NCTEXT
37918        ICSTR(J:J)=ICTEXT(J)
37919 5112 CONTINUE
37920      ANGLE=0.
37921      AXTEMP=0.
37922      CALL CALCPT(AXTEMP,PHEIG2,AYTMP2,HEIGHT,ISUBN0)
37923      CALL CALCTR(ICSTR,IHOLL3,NCTEXT)
37924#endif
37925      GOTO9000
37926C
37927C               ******************************************************
37928C               **  STEP 66--                                       **
37929C               **  TREAT THE SUN CASE - WRITTEN BY BILL ANDERSON   **
37930C               ******************************************************
37931C
37932 6600 CONTINUE
37933      NCSTR=0
37934C
37935      DO6610I=1,NCTEXT
37936        NCSTR=NCSTR+1
37937        ICTEMP=ICTEXT(I)
37938        ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
37939 6610 CONTINUE
37940C
37941      CALL GRTRSD(PX1P,PY1P,IX1P,IY1P,ISUBN0)
37942      NCSTR=NCSTR+1
37943      ITEMP=0
37944      CALL DPCONA(ITEMP,ICSTR(NCSTR:NCSTR))
37945#ifdef HAVE_SUN
37946      CALL cftext(IX1P,IY1P,ICSTR(1:NCSTR))
37947#endif
37948      GOTO9000
37949C
37950C               ******************************************************
37951C               **  STEP 22--                                       **
37952C               **  TREAT THE DEC  REGIS CASE                       **
37953C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
37954C               **  USE THE P[ (= POSITION ) INSTRUCTION            **
37955C               **  ALONG WITH INTEGER COORDINATES,                 **
37956C               **  WITH A TRAILING ]                               **
37957C               **  AND THE T' (= TEXT) INSTRUCTION                 **
37958C               **  AND THE DESIRED TEXT STRING,                    **
37959C               **  AND ' TO DENOTE THE END OF TEXT STRING,         **
37960C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
37961C               **             PAGES 118 AND 120                    **
37962C               ******************************************************
37963C
37964C
37965C     MARCH, 1991.  PACK OUTPUT.  ALSO, REGIS DRAWS CHARACTER BELOW THE
37966C                   CURSUR POSITION RATHER THAN ABOVE IT (AS DATAPLOT
37967C                   ASSUMES), SO HAVE TO ADJUST VERTICAL POSITION ONE
37968C                   CHARACTER HEIGHT.
37969C
37970 8100 CONTINUE
37971      PY1P=PY1P+PHEIG2
37972      CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
37973      ICSTR(1:2)='P['
37974      NCSTR=2
37975      NCHTOT=5
37976      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
37977      ICSTR(8:8)=','
37978      NCSTR=8
37979      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
37980      ICSTR(14:14)=']'
37981      NCSTR=14
37982      NCTEP1=NCTEXT+1
37983      IF(NCTEP1.GT.110)THEN
37984        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
37985        NCSTR=0
37986      END IF
37987C
37988      ICTEXT(NCTEP1)=''''
37989      NCSTR=NCSTR+1
37990      ICSTR(NCSTR:NCSTR)='T'
37991      NCSTR=NCSTR+1
37992      ICSTR(NCSTR:NCSTR)=''''
37993      DO8112J=1,NCTEP1
37994        K=J+NCSTR
37995        ICSTR(K:K)=ICTEXT(J)
37996 8112 CONTINUE
37997      NCSTR=K
37998      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
37999      GOTO9000
38000C
38001C               ******************************************************
38002C               **  STEP 86--                                       **
38003C               **  TREAT THE POSTSCRIPT CASE                       **
38004C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
38005C               **  XCOOR YCOOR MOVETO   (NOTE: USE UNADJUSTED COOR)**
38006C               **  (STRING) SHOW                                   **
38007C               **  NOTE:  RIGHTSHOW AND CENTSHOW ARE DATAPLOT      **
38008C               **         DEFINED PROCEDURES TO RIGHT AND CENTER   **
38009C               **         JUSTIFY STRINGS RESPECTIVELY             **
38010C               **  REFERENCE--POSTSCRIPT TUTORIAL AND COOKBOOK     **
38011C               **             FROM ADOBE SYSTEMS                   **
38012C               **  FIRST SET FONT IF REQUIRED                      **
38013C               **  CHECK FOR FOLLOWING CHARACTERS AND IF FOUND     **
38014C               **  PRECEDE WITH A BACKSLASH                        **
38015C               **  "(", ")", AND BACKSLASH                         **
38016C               ******************************************************
38017C
38018C     NOTE 2/2009: FOR BEST QUALITY GRAPHS, WE TYPICALLY WANT TO
38019C                  USE THE TYPESET QUALITY POSTSCRIPT FONTS.  HOWEVER,
38020C                  WE CANNOT CURRENTLY USE THEM WITH "SPECIAL
38021C                  CHARACTERS" (THE SP() AND CR() ARE HANDLED, BUT
38022C                  NO OTHERS).  TO ADDRESS THIS, WE WOULD LIKE TO
38023C                  HANDLE THE FOLLOWING 2 CASES:
38024C
38025C                  1) SUBSCRIPTS/SUPERSCRIPTS
38026C
38027C                  2) GREEK CHARACTERS
38028C
38029C                  ALTHOUGH THIS DOES NOT COVER ALL SPECIAL CHARACTERS,
38030C                  IT DOES COVER A HIGH PERCENTAGE OF CASES.
38031C
38032C                  IN THE FIRST PHASE, WE WILL ADDRESS SUBSCRIPTS AND
38033C                  SUPERSCRIPTS.  IN THE NEXT PHASE, WE WILL ADD
38034C                  GREEK CHARACTERS.  FIRST CALL "POSTTR" TO SEE
38035C                  IF THERE ARE ANY SUBSCRIPTS/SUPERSCRIPTS.  IF
38036C                  SO, POSTTR WILL DEFINE ARRAYS THAT SPLIT ICTEXT
38037C                  INTO MULTIPLE STRINGS AND THAT SPECIFY THE FONT
38038C                  (DEFAULT OR SYMBOL), SIZE, AND OFFSET OF EACH OF
38039C                  THESE SUBSTRINGS.  THE PRIMARY COMPLICATION IS
38040C                  THAT WE NEED TO DETERMINE THE LENGTH OF THE
38041C                  FULL STRING WHEN WE HAVE CENTER OR RIGHT
38042C                  JUSTIFICATION.
38043C
38044 8600 CONTINUE
38045C
38046      IFLAGG=0
38047      CALL POSTTR(ICTEXT,NCTEXT,ICASE,MAXSYM,
38048     1            ISTARV,ISTOPV,IFONTP,SIZEV,OFFSEV,NSTRIN,NSPEC,
38049     1            IFLAGG,
38050     1            ISUBRO,IBUGG4)
38051C
38052      IF(NSPEC.LT.1)THEN
38053        IPSTPS=INT(JHEIG2+0.5)
38054        IF(IPSTFN.NE.IPSTFC.OR.IPSTPC.NE.IPSTPS)THEN
38055          IJUNK=7
38056          DO8695I=1,IPSTMF
38057            IF(IPSTFN.NE.IPSTT1(I))GOTO8695
38058            IJUNK=I
38059            GOTO8697
38060 8695     CONTINUE
38061 8697     CONTINUE
38062          ICSTR(1:1)='/'
38063          ICSTR(2:41)=IPSTT2(IJUNK)(1:40)
38064          ICSTR(42:51)=' findfont '
38065          NCHTOT=5
38066          NCSTR=51
38067          CALL GRTRIN(IPSTPS,NCHTOT,ICSTR,NCSTR)
38068          NCSTR=NCSTR+1
38069          NCSTR2=NCSTR+17
38070          ICSTR(NCSTR:NCSTR2)=' scalefont setfont'
38071          NCSTR=NCSTR2
38072          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38073          IPSTFC=IPSTFN
38074          IPSTPC=IPSTPS
38075        ENDIF
38076        ICSTR(1:4)='/IX '
38077        NCSTR=4
38078        CALL GRTRSD(PX1,PY1P,IX,IY,ISUBN0)
38079        NCHTOT=5
38080        CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
38081        ICSTR(10:18)=' def /IY '
38082        NCSTR=18
38083        CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
38084        ICSTR(24:27)=' def'
38085        NCSTR=27
38086        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38087C
38088        ICSTR(1:1)='('
38089        NCSTR=1
38090        DO8612J=1,NCTEXT
38091          IF(ICTEXT(J).NE.'('.AND.ICTEXT(J).NE.')'.AND.
38092     1       ICTEXT(J).NE.IBASLC)GOTO8613
38093          NCSTR=NCSTR+1
38094          ICSTR(NCSTR:NCSTR)=IBASLC
38095 8613     CONTINUE
38096          NCSTR=NCSTR+1
38097          ICSTR(NCSTR:NCSTR)=ICTEXT(J)
38098 8612   CONTINUE
38099C
38100        NCSTR=NCSTR+1
38101        ICSTR(NCSTR:NCSTR)=')'
38102        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38103        IF(IJUST(1:1).EQ.'L')ICSTR(1:9)='leftshow '
38104        IF(IJUST(1:1).EQ.'C')ICSTR(1:9)='centshow '
38105        IF(IJUST(1:1).EQ.'R')ICSTR(1:9)='rightshow'
38106        NCSTR=9
38107        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38108C
38109      ELSE
38110C
38111C         DEFINE THE INITIAL POSITION.
38112C
38113        NCSTR=8
38114        ICSTR(1:NCSTR)='newpath '
38115        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
38116        NCHTOT=5
38117        CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
38118        NCSTR=14
38119        ICSTR(NCSTR:NCSTR)=' '
38120        CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
38121        ICSTR(20:26)=' moveto'
38122        NCSTR=26
38123        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38124C
38125C       CASE WHERE WE SPLIT THE STRING INTO A SERIES OF
38126C       SUBSTRINGS.
38127C
38128C         FOR LEFT JUSTIFIED STRING:
38129C             1) MOVE TO SPECIFIED START POSITION
38130C             2) LOOP THROUGH EACH SUBSTRING
38131C                A) SET FONT AND CHARACTER SIZE IF NEEDED
38132C                B) USE rmoveto TO DEFINE VERTICAL OFFSET
38133C                   (IF NEEDED)
38134C                C) USE leftshow2 TO PRINT CURRENT SUBSTRING
38135C
38136C         FOR CENTER AND RIGHT JUSTIFIED STRINGS, WE NEED TO
38137C         MAKE AN INITIAL PASS THAT SUMS UP THE LENGTH OF THE
38138C         INDIVIDUAL STRINGS TO A SINGLE TOTAL LENGTH.  HOWEVER,
38139C         WE CAN THEN DEFINE THE INITIAL STARTING POINT AND THEN
38140C         JUST USE THE LEFT JUSTIFIED ALGORITHM.
38141C
38142        IF(IJUST(1:1).EQ.'C' .OR. IJUST(1:1).EQ.'R')THEN
38143C
38144C         FOR CENTER AND RIGHT JUSTIFIED STRINGS, MAKE A PASS
38145C         TO DETERMINE THE LENGTH OF THE STRING.  FOR THIS CASE,
38146C         WE CAN IGNORE THE VERTICAL OFFSET.  HOWEVER, WE DO
38147C         NEED TO KEEP TRACK OF THE FONT AND SIZE OF EACH SUBSTRING.
38148C
38149          IPSTSV=INT(JHEIG2+0.5)
38150          IPSTCR=IPSTSV
38151          PY1PC=PY1P
38152          DO8820I=1,NSTRIN
38153            IF(ISTARV(I).GT.ISTOPV(I))GOTO8820
38154            ASIZE=SIZEV(I)
38155            IFONTT=IFONTP(I)
38156C
38157C           SET FONT AND FONT SIZE
38158C
38159            IF(ASIZE.LT.0.0)THEN
38160              IPSTCR=IPSTCR/2
38161            ELSEIF(ASIZE.GT.0.0)THEN
38162              IPSTCR=2*IPSTCR
38163            ELSE
38164              IPSTCR=IPSTSV
38165            ENDIF
38166            ICSTR(1:9)='/PSFONT /'
38167            IF(IFONTT.EQ.1)THEN
38168              ICSTR(10:15)='Symbol'
38169              ICSTR(16:49)=' '
38170            ELSE
38171              IJUNK=7
38172              DO8825II=1,IPSTMF
38173                IF(IPSTFN.NE.IPSTT1(II))GOTO8825
38174                IJUNK=II
38175                GOTO8827
38176 8825         CONTINUE
38177 8827         CONTINUE
38178              ICSTR(10:49)=IPSTT2(IJUNK)(1:40)
38179            ENDIF
38180            ICSTR(50:62)=' def /PSSIZE '
38181            NCHTOT=5
38182            NCSTR=62
38183            CALL GRTRIN(IPSTCR,NCHTOT,ICSTR,NCSTR)
38184            NCSTR=NCSTR+1
38185            NCSTR2=NCSTR+13
38186            ICSTR(NCSTR:NCSTR2)=' def setpsfont'
38187            NCSTR=NCSTR2
38188            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38189C
38190C           DETERMINE LENGTH OF CURRENT STRING AND ADD IT TO
38191C           THE TOTAL.
38192C
38193            ICSTR(1:1)='('
38194            NCSTR=1
38195            DO8832J=ISTARV(I),ISTOPV(I)
38196              IF(ICTEXT(J).NE.'('.AND.ICTEXT(J).NE.')'.AND.
38197     1          ICTEXT(J).NE.IBASLC)GOTO8833
38198              NCSTR=NCSTR+1
38199              ICSTR(NCSTR:NCSTR)=IBASLC
38200 8833         CONTINUE
38201              NCSTR=NCSTR+1
38202              ICSTR(NCSTR:NCSTR)=ICTEXT(J)
38203 8832       CONTINUE
38204C
38205            NCSTR=NCSTR+1
38206            ICSTR(NCSTR:NCSTR)=')'
38207            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38208            IF(IJUST(1:1).EQ.'C')THEN
38209              NCSTR=14
38210              ICSTR(1:NCSTR)='psstringwidthc'
38211              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38212            ELSEIF(IJUST(1:1).EQ.'R')THEN
38213              NCSTR=14
38214              ICSTR(1:NCSTR)='psstringwidthr'
38215              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38216            ENDIF
38217C
38218 8820     CONTINUE
38219        ENDIF
38220C
38221C       NOW DRAW EACH OF THE SUBSTRINGS
38222C
38223        IPSTSV=INT(JHEIG2+0.5)
38224        IPSTCR=IPSTSV
38225        PY1PC=PY1P
38226        DO8720I=1,NSTRIN
38227          IF(ISTARV(I).GT.ISTOPV(I))GOTO8720
38228          ASIZE=SIZEV(I)
38229          AOFFS=OFFSEV(I)
38230          IFONTT=IFONTP(I)
38231C
38232C         STEP 2A: SET FONT AND FONT SIZE
38233C
38234          IF(ASIZE.LT.0.0)THEN
38235            IPSTCR=IPSTCR/2
38236          ELSEIF(ASIZE.GT.0.0)THEN
38237            IPSTCR=2*IPSTCR
38238          ELSE
38239            IPSTCR=IPSTSV
38240          ENDIF
38241          ICSTR(1:9)='/PSFONT /'
38242          IF(IFONTT.EQ.1)THEN
38243            ICSTR(10:15)='Symbol'
38244            ICSTR(16:49)=' '
38245          ELSE
38246            IJUNK=7
38247            DO8725II=1,IPSTMF
38248              IF(IPSTFN.NE.IPSTT1(II))GOTO8725
38249              IJUNK=II
38250              GOTO8727
38251 8725       CONTINUE
38252 8727       CONTINUE
38253            ICSTR(10:49)=IPSTT2(IJUNK)(1:40)
38254          ENDIF
38255          ICSTR(50:62)=' def /PSSIZE '
38256          NCHTOT=5
38257          NCSTR=62
38258          CALL GRTRIN(IPSTCR,NCHTOT,ICSTR,NCSTR)
38259          NCSTR=NCSTR+1
38260          NCSTR2=NCSTR+13
38261          ICSTR(NCSTR:NCSTR2)=' def setpsfont'
38262          NCSTR=NCSTR2
38263          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38264C
38265C         STEP 2B: SET RELATIVE VERTICAL OFFSET IF NEEDED
38266C
38267          IF(AOFFS.GT.0.0)THEN
38268            PXTEMP=0.0
38269            POFFST=PYLEC/2.0
38270            CALL GRTRSD(PXTEMP,POFFST,IX,IY,ISUBN0)
38271            NCHTOT=5
38272            NCSTR=0
38273            CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
38274            NCSTR=NCSTR+1
38275            ICSTR(NCSTR:NCSTR)=' '
38276            CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
38277            NCSTR=NCSTR+1
38278            NCSTR2=NCSTR+7
38279            ICSTR(NCSTR:NCSTR2)=' rmoveto'
38280            NCSTR=NCSTR2
38281            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38282          ELSEIF(AOFFS.LT.0.0)THEN
38283            PXTEMP=0.0
38284            POFFST=PYLEC/2.0
38285            CALL GRTRSD(PXTEMP,POFFST,IX,IY,ISUBN0)
38286            IY=-IY
38287            NCHTOT=5
38288            NCSTR=0
38289            CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
38290            NCSTR=NCSTR+1
38291            ICSTR(NCSTR:NCSTR)=' '
38292            CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
38293            NCSTR=NCSTR+1
38294            NCSTR2=NCSTR+7
38295            ICSTR(NCSTR:NCSTR2)=' rmoveto'
38296            NCSTR=NCSTR2
38297            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38298          ENDIF
38299C
38300C         STEP 2C: PRINT CURRENT SUBSTRING
38301C
38302          ICSTR(1:1)='('
38303          NCSTR=1
38304          DO8732J=ISTARV(I),ISTOPV(I)
38305            IF(ICTEXT(J).NE.'('.AND.ICTEXT(J).NE.')'.AND.
38306     1        ICTEXT(J).NE.IBASLC)GOTO8733
38307            NCSTR=NCSTR+1
38308            ICSTR(NCSTR:NCSTR)=IBASLC
38309 8733       CONTINUE
38310            NCSTR=NCSTR+1
38311            ICSTR(NCSTR:NCSTR)=ICTEXT(J)
38312 8732     CONTINUE
38313C
38314          NCSTR=NCSTR+1
38315          ICSTR(NCSTR:NCSTR)=')'
38316          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38317          ICSTR(1:10)='leftshow2 '
38318          NCSTR=10
38319          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38320C
38321 8720   CONTINUE
38322C
38323C       RESET DEFAULT FONT AND POINT SIZE
38324C
38325        ICSTR(1:9)='/PSFONT /'
38326        IJUNK=7
38327        DO8925II=1,IPSTMF
38328          IF(IPSTFN.NE.IPSTT1(II))GOTO8925
38329          IJUNK=II
38330          GOTO8927
38331 8925   CONTINUE
38332 8927   CONTINUE
38333        ICSTR(10:49)=IPSTT2(IJUNK)(1:40)
38334        ICSTR(50:62)=' def /PSSIZE '
38335        NCHTOT=5
38336        NCSTR=62
38337        CALL GRTRIN(IPSTCR,NCHTOT,ICSTR,NCSTR)
38338        NCSTR=NCSTR+1
38339        NCSTR2=NCSTR+13
38340        ICSTR(NCSTR:NCSTR2)=' def setpsfont'
38341        NCSTR=NCSTR2
38342        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38343      ENDIF
38344C
38345      GOTO9000
38346C
38347C               ******************************************************
38348C               **  STEP 91--                                       **
38349C               **  TREAT THE QUIC       CASE                       **
38350C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
38351C               **  MOVE: ^IHXXXXX^IVXXXXX                          **
38352C               **  SET DEFAULT FONT:^ISXXXXX                       **
38353C               **  SET FONT FOR CURRENT LINE: ^SMXXXXX             **
38354C               **  ENTER TEXT                                      **
38355C               **  REFERENCE--QUIC PROGRAMMING MANUAL FOR QMS      **
38356C               **             CHAPTER 7 DISCUSSES FONTS            **
38357C               ******************************************************
38358C
38359C
38360 9100 CONTINUE
38361      IFONTT=IQUIFN
38362      IF(IORNSW.EQ.'PORT'.AND.(
38363     1   IFONTT.EQ.521 .OR. IFONTT.EQ.522 .OR.
38364     1   IFONTT.EQ.523 .OR. IFONTT.EQ.524))IFONTT=10
38365      IF(IORNSW.NE.'PORT'.AND.(
38366     1   IFONTT.EQ.124 .OR. IFONTT.EQ.144 .OR.
38367     1   IFONTT.EQ.16  .OR. IFONTT.EQ.328 .OR.
38368     1   IFONTT.EQ.998 .OR. IFONTT.EQ.404 .OR.
38369     1   IFONTT.EQ.444 .OR. IFONTT.EQ.532))IFONTT=10
38370      CALL DPCONA(94,ICARAT)
38371      IF(IFONTT.EQ.IQUIFC)GOTO9105
38372      ICSTR(1:1)=ICARAT
38373      ICSTR(2:3)='IS'
38374      IQUIFC=IFONTT
38375      KFONT=IFONTT
38376      NCHTOT=-5
38377      NCSTR=3
38378      CALL GRTRIN(KFONT,NCHTOT,ICSTR,NCSTR)
38379      NCSTR=8
38380      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38381C
38382 9105 CONTINUE
38383      PYTEMP=100.-PY1P
38384      CALL QUICPT(PX1P,PYTEMP,IX,IY,ISUBN0)
38385      ICSTR(1:1)=ICARAT
38386      ICSTR(2:3)='IH'
38387      NCSTR=3
38388      NCHTOT=-5
38389      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
38390      ICSTR(9:9)=ICARAT
38391      ICSTR(10:11)='IV'
38392      NCSTR=11
38393      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
38394      NCSTR=16
38395C
38396      DO9112J=1,NCTEXT
38397        K=J+NCSTR
38398        ICSTR(K:K)=ICTEXT(J)
38399 9112 CONTINUE
38400      NCSTR=K
38401      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38402      GOTO9000
38403C
38404C               ******************************************************
38405C               **  STEP 96--                                       **
38406C               **  TREAT THE X11        CASE                       **
38407C               **  NOTE THAT JUSTIFICATION, POSITIONING, ETC. IS   **
38408C               **  HANDLED BY THE C ROUTINE.  ALSO, THE CHARACTER  **
38409C               **  STRING IS PASSED TO C AS AN INTEGER ARRAY       **
38410C               **  CONTAINING THE ASCII DECIMAL EQUIVALENTS        **
38411C               ******************************************************
38412C
38413C
38414 9600 CONTINUE
38415#ifdef HAVE_X11
38416      IF(IX11OF.EQ.'OFF')GOTO9000
38417C
38418      CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
38419C
38420      DO9605I=1,NCTEXT
38421        IC1=ICTEXT(I)(1:1)
38422        CALL DPCOAN(IC1,IJUNK)
38423        STRING(I)=IJUNK
38424 9605 CONTINUE
38425      STRING(NCTEXT+1)=0
38426C
38427      ILAST=80
38428      DO9610I=80,1,-1
38429        ILAST=I
38430        IF(IX11FN(I:I).NE.' ')GOTO9619
38431 9610 CONTINUE
38432 9619 CONTINUE
38433      DO9620I=1,ILAST
38434        CALL DPCOAN(IX11FN(I:I),IJUNK)
38435        IADE(I)=IJUNK
38436 9620 CONTINUE
38437      IADE(ILAST+1)=0
38438C
38439      CALL XTATTR(IADE,IXERR)
38440      IF(IXERR.EQ.1) THEN
38441        WRITE(ICOUT,9621)
38442 9621   FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE CURRENT FONT')
38443        CALL DPWRST('XXX','BUG ')
38444      ELSEIF(IXERR.EQ.2)THEN
38445        WRITE(ICOUT,9622)
38446 9622   FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE DEFAULT FONT')
38447        CALL DPWRST('XXX','BUG ')
38448      END IF
38449C
38450      IFONTH=0
38451      IFONTV=0
38452      IF(IJUST.EQ.'LEFT')IFONTH=0
38453      IF(IJUST.EQ.'CENT')IFONTH=1
38454      IF(IJUST.EQ.'RIGH')IFONTH=2
38455      IF(IJUST.EQ.'LJUS')IFONTH=0
38456      IF(IJUST.EQ.'CJUS')IFONTH=1
38457      IF(IJUST.EQ.'RJUS')IFONTH=2
38458      IF(IJUST.EQ.'LEBO')IFONTH=0
38459      IF(IJUST.EQ.'CEBO')IFONTH=1
38460      IF(IJUST.EQ.'RIBO')IFONTH=2
38461      IF(IJUST.EQ.'LECE')IFONTH=0
38462      IF(IJUST.EQ.'CECE')IFONTH=1
38463      IF(IJUST.EQ.'RICE')IFONTH=2
38464      IF(IJUST.EQ.'LETO')IFONTH=0
38465      IF(IJUST.EQ.'CETO')IFONTH=1
38466      IF(IJUST.EQ.'RITO')IFONTH=2
38467      IF(IJUST.EQ.'LEFT')IFONTV=1
38468      IF(IJUST.EQ.'CENT')IFONTV=1
38469      IF(IJUST.EQ.'RIGH')IFONTV=1
38470      IF(IJUST.EQ.'LJUS')IFONTV=1
38471      IF(IJUST.EQ.'CJUS')IFONTV=1
38472      IF(IJUST.EQ.'RJUS')IFONTV=1
38473      IF(IJUST.EQ.'LEBO')IFONTV=1
38474      IF(IJUST.EQ.'CEBO')IFONTV=1
38475      IF(IJUST.EQ.'RIBO')IFONTV=1
38476      IF(IJUST.EQ.'LECE')IFONTV=0
38477      IF(IJUST.EQ.'CECE')IFONTV=0
38478      IF(IJUST.EQ.'RICE')IFONTV=0
38479      IF(IJUST.EQ.'LETO')IFONTV=2
38480      IF(IJUST.EQ.'CETO')IFONTV=2
38481      IF(IJUST.EQ.'RITO')IFONTV=2
38482      IXERR=0
38483      CALL XTEXTH(STRING,IX,IY,IFONTH,IFONTV,IXERR)
38484#endif
38485      GOTO9000
38486C
38487CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
38488CCCCC AND REFIXED                       SEPTEMBER 1995
38489C               *************************************************
38490C               **  STEP 100--                                 **
38491C               **  TREAT THE VGA VIA TURBO-C       CASE       **
38492C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
38493C               **             ENHANCEMENTS, PAGE 124, 113.    **
38494C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
38495C               **             PAGE 324-325, 256.              **
38496C               **  REFERENCE--WEISKAMP, POWER GRAPHICS        **
38497C               **             USING TURBO C, PAGE 59-60, 54-55**
38498C               *************************************************
38499C
3850010000 CONTINUE
38501      IF(ITCST.EQ.'CLOS')GOTO9000
38502C
38503CCCCC THE FOLLOWING 2 LINES OF CODE WERE REPLACED  SEPTEMBER 1994
38504CCCCC BY THE SUBSEQUENT 7 LINES OF CODE            SEPTEMBER 1994
38505CCCCC TO FIX C-SIDE MULTIPLOTTING NOT WORKING      SEPTEMBER 1994
38506C
38507CCCCC CALL TCMOTO(PX1,PY1)
38508CCCCC CALL TCWRTE(ICTEXT,NCTEXT)
38509C
38510      IF(NCTEXT.GT.0)THEN
38511c
38512CCCCC   SEE COMMENTS FOR GENERAL CODED (STEP 32) FOR NEXT 2 LINES
38513C
38514CCCCC   THE FOLLOWING 2 LINES WAS CHANGED     JANUARY 1995
38515CCCCC   TO FIX THE TIC JUSTIFICATION PROBLEM  JANUARY 1995
38516CCCCC   IF(IJUSSW.EQ.'ON')PX1P=PX1
38517CCCCC   IF(IJUSSW.EQ.'ON')PY1P=PY1
38518        PX1P=PX1
38519        PY1P=PY1
38520        CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
38521        PX1P=AX
38522        PY1P=AY
38523CTURB   CALL TCMOTO(PX1P,PY1P)
38524CTURB   CALL TCWRTE(ICTEXT,NCTEXT)
38525C
38526      ENDIF
38527C
38528      GOTO9000
38529C
38530C               ******************************************************
38531C               **  STEP 110--                                      **
38532C               **  TREAT THE GKS                DRIVER             **
38533C               ******************************************************
38534C
3853511000 CONTINUE
38536      GOTO9000
38537C
38538C               ******************************************************
38539C               **  STEP 120--                                      **
38540C               **  TREAT THE GD                     DRIVER         **
38541C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
38542C               **  1) JPEG                                         **
38543C               **  2) PNG                                          **
38544C               **  3) GIF                                          **
38545C               ******************************************************
38546C
3854712000 CONTINUE
38548#ifdef HAVE_GD
38549C
38550      CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
38551C
38552      IFONTZ=0
38553      IF(IGDFN(1:5).EQ.'SMALL')IFONTZ=1
38554      IF(IGDFN(1:5).EQ.'LARGE')IFONTZ=2
38555      IF(IGDFN(1:10).EQ.'MEDIUMBOLD')IFONTZ=3
38556      IF(IGDFN(1:5).EQ.'GIANT')IFONTZ=4
38557      IF(IGDFN(1:4).EQ.'TINY')IFONTZ=5
38558C
38559      DO12605I=1,NCTEXT
38560        IC1=ICTEXT(I)(1:1)
38561        CALL DPCOAN(IC1,IJUNK)
38562        STRING(I)=IJUNK
3856312605 CONTINUE
38564      STRING(NCTEXT+1)=0
38565C
38566      ILAST=80
38567      DO12610I=80,1,-1
38568        ILAST=I
38569        IF(IGDFN(I:I).NE.' ')GOTO12619
3857012610 CONTINUE
3857112619 CONTINUE
38572      DO12620I=1,ILAST
38573        CALL DPCOAN(IGDFN(I:I),IJUNK)
38574        IADE(I)=IJUNK
3857512620 CONTINUE
38576      IADE(ILAST+1)=0
38577C
38578      IFONTH=0
38579      IFONTV=0
38580      IF(IJUST.EQ.'LEFT')IFONTH=0
38581      IF(IJUST.EQ.'CENT')IFONTH=1
38582      IF(IJUST.EQ.'RIGH')IFONTH=2
38583      IF(IJUST.EQ.'LJUS')IFONTH=0
38584      IF(IJUST.EQ.'CJUS')IFONTH=1
38585      IF(IJUST.EQ.'RJUS')IFONTH=2
38586      IF(IJUST.EQ.'LEBO')IFONTH=0
38587      IF(IJUST.EQ.'CEBO')IFONTH=1
38588      IF(IJUST.EQ.'RIBO')IFONTH=2
38589      IF(IJUST.EQ.'LECE')IFONTH=0
38590      IF(IJUST.EQ.'CECE')IFONTH=1
38591      IF(IJUST.EQ.'RICE')IFONTH=2
38592      IF(IJUST.EQ.'LETO')IFONTH=0
38593      IF(IJUST.EQ.'CETO')IFONTH=1
38594      IF(IJUST.EQ.'RITO')IFONTH=2
38595      IF(IJUST.EQ.'LEFT')IFONTV=1
38596      IF(IJUST.EQ.'CENT')IFONTV=1
38597      IF(IJUST.EQ.'RIGH')IFONTV=1
38598      IF(IJUST.EQ.'LJUS')IFONTV=1
38599      IF(IJUST.EQ.'CJUS')IFONTV=1
38600      IF(IJUST.EQ.'RJUS')IFONTV=1
38601      IF(IJUST.EQ.'LEBO')IFONTV=1
38602      IF(IJUST.EQ.'CEBO')IFONTV=1
38603      IF(IJUST.EQ.'RIBO')IFONTV=1
38604      IF(IJUST.EQ.'LECE')IFONTV=0
38605      IF(IJUST.EQ.'CECE')IFONTV=0
38606      IF(IJUST.EQ.'RICE')IFONTV=0
38607      IF(IJUST.EQ.'LETO')IFONTV=2
38608      IF(IJUST.EQ.'CETO')IFONTV=2
38609      IF(IJUST.EQ.'RITO')IFONTV=2
38610      IERR=0
38611C
38612      CALL GDTXTH(IADE,STRING,IFONTZ,IX,IY,IFONTH,IFONTV,
38613     1            JCOL,JHEIG2,IERR)
38614C
38615#endif
38616      GOTO9000
38617C
38618C               ******************************************************
38619C               **  STEP 130--                                      **
38620C               **  TREAT THE ABSOFT                 DRIVER         **
38621C               ******************************************************
38622C
3862313000 CONTINUE
38624      GOTO9000
38625C
38626C               ******************************************************
38627C               **  STEP 135--                                      **
38628C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
38629C               ******************************************************
38630C
3863113500 CONTINUE
38632C
38633      CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
38634C
38635      DO13505I=1,NCTEXT
38636        IC1=ICTEXT(I)(1:1)
38637        CALL DPCOAN(IC1,IJUNK)
38638        STRING(I)=IJUNK
3863913505 CONTINUE
38640      STRING(NCTEXT+1)=0
38641C
38642      ILAST=80
38643      DO13510I=80,1,-1
38644        ILAST=I
38645        IF(IAQUFN(I:I).NE.' ')GOTO13519
3864613510 CONTINUE
3864713519 CONTINUE
38648      DO13520I=1,ILAST
38649        CALL DPCOAN(IAQUFN(I:I),IJUNK)
38650        IADE(I)=IJUNK
3865113520 CONTINUE
38652      IADE(ILAST+1)=0
38653C
38654COLD  aqtAddLabel(ICTEXT(1:NCTEXT),PX1,PY1,AROT,IAQJUS)
38655      IFONTH=0
38656      IFONTV=0
38657      IF(IJUSTH.EQ.'LEFT')IFONTH=0
38658      IF(IJUSTH.EQ.'CENT')IFONTH=1
38659      IF(IJUSTH.EQ.'RIGH')IFONTH=2
38660      IF(IJUSTV.EQ.'BOTT')IFONTV=0
38661      IF(IJUSTV.EQ.'MIDD')IFONTV=1
38662      IF(IJUSTV.EQ.'TOP ')IFONTV=2
38663#ifdef HAVE_AQUA
38664      CALL aqtxth(STRING,IX,IY,IFONTH,IFONTV,IADE,IERR)
38665#endif
38666      GOTO9000
38667C
38668C
38669C               ******************************************************
38670C               **  STEP 150--                                      **
38671C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
38672C               ******************************************************
38673C
3867415000 CONTINUE
38675      CALL GRTRSD(PX1,PY1P,IX,IY,ISUBN0)
38676      ICSTR(1:1)=IBASLC
38677      ICSTR(2:5)='put('
38678      NCSTR=5
38679      NCHTOT=5
38680      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
38681      NCSTR=NCSTR+1
38682      ICSTR(NCSTR:NCSTR)=','
38683      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
38684      NCSTR=NCSTR+1
38685      ICSTR(NCSTR:NCSTR+15)='){ makebox(0,0)['
38686      ICSTR(NCSTR+2:NCSTR+2)=IBASLC
38687      NCSTR=NCSTR+15
38688C
38689      IF(IJUSTV.EQ.'CENT')THEN
38690        NCSTR=NCSTR+1
38691        ICSTR(NCSTR:NCSTR)='c'
38692      ELSEIF(IJUSTV.EQ.'BOTT')THEN
38693        NCSTR=NCSTR+1
38694        ICSTR(NCSTR:NCSTR)='b'
38695      ELSEIF(IJUSTV.EQ.'TOP ')THEN
38696        NCSTR=NCSTR+1
38697        ICSTR(NCSTR:NCSTR)='t'
38698      ENDIF
38699C
38700      IF(IJUSTH.EQ.'CENT')THEN
38701        NCSTR=NCSTR+1
38702        ICSTR(NCSTR:NCSTR)='c'
38703      ELSEIF(IJUSTH.EQ.'LEFT')THEN
38704        NCSTR=NCSTR+1
38705        ICSTR(NCSTR:NCSTR)='l'
38706      ELSEIF(IJUSTH.EQ.'RIGH')THEN
38707        NCSTR=NCSTR+1
38708        ICSTR(NCSTR:NCSTR)='r'
38709      ENDIF
38710      NCSTR=NCSTR+1
38711      ICSTR(NCSTR:NCSTR)=']'
38712C
38713      DO15110J=1,NCTEXT
38714        ICSTR2(J:J)=ICTEXT(J)(1:1)
3871515110 CONTINUE
38716      MAXWID=130
38717      CALL LATCON(ICSTR2,NCTEXT,ICSTR3,NCTEX2,MAXWID,ISUBRO,IERROR)
38718C
38719      NCSTR=NCSTR+1
38720      ICSTR(NCSTR:NCSTR)='{'
38721      ICNT=NCSTR
38722      DO15120J=1,NCTEX2
38723        ICNT=ICNT+1
38724        ICSTR(ICNT:ICNT)=ICSTR3(J:J)
3872515120 CONTINUE
38726      NCSTR=ICNT
38727      NCSTR=NCSTR+1
38728      ICSTR(NCSTR:NCSTR+1)='}}'
38729      NCSTR=NCSTR+1
38730      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38731      GOTO9000
38732C
38733C               ******************************************************
38734C               **  STEP 160--                                      **
38735C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
38736C               ******************************************************
38737C
38738C     JULY 2015.  FOR THE CHROME BROWSER, NEED TO HAVE
38739C
38740C                   X="95" Y="233"
38741C
38742C                 RATHER THAN
38743C
38744C                   X="   95" Y="   233"
38745C
3874616000 CONTINUE
38747C
38748      CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
38749C
38750      IF(IJUSTV.EQ.'TOP')THEN
38751        IY=IY+JHEIG2
38752      ELSEIF(IJUSTV.EQ.'CENT')THEN
38753        IY=IY+(JHEIG2/2)
38754      ELSE
38755        CONTINUE
38756      ENDIF
38757C
38758      CALL DPCONA(34,IQUOTE)
38759C
38760      ISVGLN=ISVGLN+1
38761      ICSTR(1:9)='   <g id='
38762      ICSTR(10:10)=IQUOTE
38763      NCSTR=10
38764      IF(ISVGLN.LE.9)THEN
38765        NCHTOT=1
38766      ELSEIF(ISVGLN.LE.99)THEN
38767        NCHTOT=2
38768      ELSEIF(ISVGLN.LE.999)THEN
38769        NCHTOT=3
38770      ELSEIF(ISVGLN.LE.9999)THEN
38771        NCHTOT=4
38772      ELSEIF(ISVGLN.LE.99999)THEN
38773        NCHTOT=5
38774      ELSE
38775        NCHTOT=6
38776      ENDIF
38777      CALL GRTRIN(ISVGLN,NCHTOT,ICSTR,NCSTR)
38778      NCSTR=NCSTR+1
38779      ICSTR(NCSTR:NCSTR)=IQUOTE
38780      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38781C
38782      IF(ISVGSS(1:3).EQ.'EXT')THEN
38783        NCSTR=12
38784        ICSTR(1:NCSTR)='      class='
38785        NCSTR=NCSTR+1
38786        ICSTR(NCSTR:NCSTR)=IQUOTE
38787        NCSTR=NCSTR+1
38788C
38789        IF(IJUSTH.EQ.'CENT')THEN
38790          ICSTR(NCSTR:NCSTR+16)='center-horizontal'
38791          NCSTR=NCSTR+17
38792        ELSEIF(IJUSTH.EQ.'LEFT')THEN
38793          ICSTR(NCSTR:NCSTR+14)='left-horizontal'
38794          NCSTR=NCSTR+15
38795        ELSEIF(IJUSTH.EQ.'RIGH')THEN
38796          ICSTR(NCSTR:NCSTR+15)='right-horizontal'
38797          NCSTR=NCSTR+16
38798        ENDIF
38799C
38800        ICSTR(NCSTR:NCSTR)=IQUOTE
38801        NCSTR=-NCSTR
38802        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38803C
38804        CALL GRTRCO('FORE',ISVGFC,JCOL2)
38805        IFLAG=1
38806        ICSTR(1:12)='      style='
38807        ICSTR(13:13)=IQUOTE
38808        NCSTR=-13
38809        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38810        NCSTR=19
38811        ICSTR(1:NCSTR)='             fill:#'
38812        NCHTOT=2
38813        JTEMP=JCOL
38814        IF(JTEMP.LE.0)THEN
38815C
38816C         DATAPLOT CURRENTLY ALLOWS GREYSCALE VALUES IN
38817C         THE RANGE 0 TO 100.  FOR SPECIFYING COLOR TO SVG,
38818C         SCALE THAT 0 TO 100 VALUE TO A 0 TO 255 VALUE.
38819C
38820          AVAL=(255./100.)*REAL(ABS(JTEMP))
38821          IF(AVAL.LE.0.0)AVAL=0.0
38822          IF(AVAL.GE.255.0)AVAL=255.0
38823          JRED=INT(AVAL+0.5)
38824          JBLUE=JRED
38825          JGREEN=JRED
38826        ELSE
38827          IF(JTEMP.LT.1 .OR. JTEMP.GT.MAXCLR)JTEMP=1
38828          JRED=IRED(JTEMP)
38829          JGREEN=IGREEN(JTEMP)
38830          JBLUE=IBLUE(JTEMP)
38831        ENDIF
38832        CALL DPCONX(JRED,ICJUNK)
38833        NCSTR=NCSTR+1
38834        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
38835        NCSTR=NCSTR+1
38836        CALL DPCONX(JGREEN,ICJUNK)
38837        NCSTR=NCSTR+1
38838        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
38839        NCSTR=NCSTR+1
38840        CALL DPCONX(JBLUE,ICJUNK)
38841        NCSTR=NCSTR+1
38842        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
38843        NCSTR=NCSTR+2
38844        ICSTR(NCSTR:NCSTR)=';'
38845        NCSTR=-NCSTR
38846        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38847        NCSTR=22
38848        ICSTR(1:NCSTR)='            font-size:'
38849        NCHTOT=3
38850        CALL GRTRIN(JHEIG2,NCHTOT,ICSTR,NCSTR)
38851        NCSTR=NCSTR+1
38852        ICSTR(NCSTR:NCSTR+2)='pt;'
38853        NCSTR=NCSTR+2
38854        NCSTR=-NCSTR
38855        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38856        NCSTR=13
38857        ICSTR(1:NCSTR)='             '
38858        NCSTR=NCSTR+1
38859        ICSTR(NCSTR:NCSTR)=IQUOTE
38860        NCSTR=NCSTR+1
38861        ICSTR(NCSTR:NCSTR)='>'
38862        NCSTR=-NCSTR
38863        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38864C
38865      ELSE
38866        NCSTR=14
38867        ICSTR(1:NCSTR)='        style='
38868        NCSTR=NCSTR+1
38869        ICSTR(NCSTR:NCSTR)=IQUOTE
38870        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38871C
38872        NCSTR=21
38873        ICSTR(1:NCSTR)='         font-family:'
38874        DO16010I=32,1,-1
38875          NCTEMP=I
38876          IF(ISVGFN(I:I).NE.' ')GOTO16011
3887716010   CONTINUE
3887816011   CONTINUE
38879        NCSTR=NCSTR+1
38880        ICSTR(NCSTR:NCSTR+NCTEMP-1)=ISVGFN(1:NCTEMP)
38881        NCSTR=NCSTR+NCTEMP
38882        ICSTR(NCSTR:NCSTR)=';'
38883        NCSTR=-NCSTR
38884        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38885        IF(ISVGFW.EQ.'NORM')THEN
38886          NCSTR=28
38887          ICSTR(1:NCSTR)='         font-weight:normal;'
38888          NCSTR=-NCSTR
38889        ELSE
38890          NCSTR=26
38891          ICSTR(1:NCSTR)='         font-weight:bold;'
38892          NCSTR=-NCSTR
38893        ENDIF
38894        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38895        IF(ISVGST.EQ.'ITAL')THEN
38896          NCSTR=27
38897          ICSTR(1:NCSTR)='         font-style:italic;'
38898          NCSTR=-NCSTR
38899        ELSE
38900          NCSTR=27
38901          ICSTR(1:NCSTR)='         font-style:normal;'
38902          NCSTR=-NCSTR
38903        ENDIF
38904        NCSTR=19
38905        ICSTR(1:NCSTR)='         font-size:'
38906        NCHTOT=3
38907        CALL GRTRIN(JHEIG2,NCHTOT,ICSTR,NCSTR)
38908        NCSTR=NCSTR+1
38909        ICSTR(NCSTR:NCSTR+2)='pt;'
38910        NCSTR=NCSTR+2
38911        NCSTR=-NCSTR
38912        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38913C
38914        NCSTR=28
38915        ICSTR(1:NCSTR)='         stroke:none; fill:#'
38916        NCHTOT=2
38917        JTEMP=JCOL
38918        IF(JTEMP.LE.0)THEN
38919C
38920C         DATAPLOT CURRENTLY ALLOWS GREYSCALE VALUES IN
38921C         THE RANGE 0 TO 100.  FOR SPECIFYING COLOR TO SVG,
38922C         SCALE THAT 0 TO 100 VALUE TO A 0 TO 255 VALUE.
38923C
38924          AVAL=(255./100.)*REAL(ABS(JTEMP))
38925          IF(AVAL.LE.0.0)AVAL=0.0
38926          IF(AVAL.GE.255.0)AVAL=255.0
38927          JRED=INT(AVAL+0.5)
38928          JBLUE=JRED
38929          JGREEN=JRED
38930        ELSE
38931          IF(JTEMP.LT.1 .OR. JTEMP.GT.MAXCLR)JTEMP=1
38932          JRED=IRED(JTEMP)
38933          JGREEN=IGREEN(JTEMP)
38934          JBLUE=IBLUE(JTEMP)
38935        ENDIF
38936        CALL DPCONX(JRED,ICJUNK)
38937        NCSTR=NCSTR+1
38938        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
38939        NCSTR=NCSTR+1
38940        CALL DPCONX(JGREEN,ICJUNK)
38941        NCSTR=NCSTR+1
38942        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
38943        NCSTR=NCSTR+1
38944        CALL DPCONX(JBLUE,ICJUNK)
38945        NCSTR=NCSTR+1
38946        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
38947        NCSTR=NCSTR+2
38948        ICSTR(NCSTR:NCSTR)=';'
38949C
38950        NCSTR=NCSTR+1
38951        ICSTR(NCSTR:NCSTR)=IQUOTE
38952        NCSTR=NCSTR+1
38953        ICSTR(NCSTR:NCSTR)='>'
38954        NCSTR=-NCSTR
38955        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
38956C
38957      ENDIF
38958C
38959      IF(IX.LE.9)THEN
38960        NCHTOT=1
38961      ELSEIF(IX.LE.99)THEN
38962        NCHTOT=2
38963      ELSEIF(IX.LE.999)THEN
38964        NCHTOT=3
38965      ELSEIF(IX.LE.9999)THEN
38966        NCHTOT=4
38967      ELSE
38968        NCHTOT=5
38969      ENDIF
38970C
38971      ICSTR(1:11)='   <text x='
38972      NCSTR=12
38973      ICSTR(NCSTR:NCSTR)=IQUOTE
38974      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
38975      NCSTR=NCSTR+1
38976      ICSTR(NCSTR:NCSTR)=IQUOTE
38977      NCSTR=NCSTR+1
38978      ICSTR(NCSTR:NCSTR+2)=' y='
38979      NCSTR=NCSTR+3
38980      ICSTR(NCSTR:NCSTR)=IQUOTE
38981C
38982      IF(IY.LE.9)THEN
38983        NCHTOT=1
38984      ELSEIF(IY.LE.99)THEN
38985        NCHTOT=2
38986      ELSEIF(IY.LE.999)THEN
38987        NCHTOT=3
38988      ELSEIF(IY.LE.9999)THEN
38989        NCHTOT=4
38990      ELSE
38991        NCHTOT=5
38992      ENDIF
38993C
38994      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
38995      NCSTR=NCSTR+1
38996      ICSTR(NCSTR:NCSTR)=IQUOTE
38997      NCHTOT=5
38998C
38999      ICSTR(NCSTR+1:NCSTR+7)=' style='
39000      NCSTR=NCSTR+8
39001      ICSTR(NCSTR:NCSTR)=IQUOTE
39002      IF(IJUSTH.EQ.'CENT')THEN
39003        ICSTR(NCSTR+1:NCSTR+19)='text-anchor:middle;'
39004        NCSTR=NCSTR+19
39005      ELSEIF(IJUSTH.EQ.'RIGH')THEN
39006        ICSTR(NCSTR+1:NCSTR+16)='text-anchor:end;'
39007        NCSTR=NCSTR+16
39008      ELSE
39009        ICSTR(NCSTR+1:NCSTR+18)='text-anchor:start;'
39010        NCSTR=NCSTR+18
39011      ENDIF
39012      NCSTR=NCSTR+1
39013      ICSTR(NCSTR:NCSTR)=IQUOTE
39014      NCSTR=NCSTR+1
39015      ICSTR(NCSTR:NCSTR)='>'
39016C
39017C     2012/03: CHECK FOR "<" OR ">".  NEED TO CONVERT THESE TO &lt; AND
39018C              &gt; TO DISTINGUISH THEM FROM TAG IDENTIFIERS.
39019C     2015/11: CHECK FOR "&".  NEED TO CONVERT THESE TO &amp; .
39020C
39021      DO16112J=1,NCTEXT
39022        IF(ICTEXT(J).EQ.'<')THEN
39023          NCSTR=NCSTR+1
39024          ICSTR(NCSTR:NCSTR+3)='&lt;'
39025          NCSTR=NCSTR+3
39026        ELSEIF(ICTEXT(J).EQ.'>')THEN
39027          NCSTR=NCSTR+1
39028          ICSTR(NCSTR:NCSTR+3)='&gt;'
39029          NCSTR=NCSTR+3
39030        ELSEIF(ICTEXT(J).EQ.'&')THEN
39031          NCSTR=NCSTR+1
39032          ICSTR(NCSTR:NCSTR+4)='&amp;'
39033          NCSTR=NCSTR+4
39034        ELSE
39035          NCSTR=NCSTR+1
39036          ICSTR(NCSTR:NCSTR)=ICTEXT(J)
39037        ENDIF
3903816112 CONTINUE
39039C
39040      ICSTR(NCSTR+1:NCSTR+7)='</text>'
39041      NCSTR=NCSTR+7
39042      NCSTR=-NCSTR
39043      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
39044C
39045      ICSTR(1:7)='   </g>'
39046      NCSTR=-7
39047      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
39048C
39049      GOTO9000
39050C
39051C               ******************************************************
39052C               **  STEP 170--                                      **
39053C               **  TREAT THE CAIRO                          DRIVER **
39054C               ******************************************************
39055C
3905617000 CONTINUE
39057#ifdef HAVE_CAIRO
39058C
39059C     CHECK FOR X11 DEVICE, HARDWARE TEXT NOT SUPPORTED
39060C
39061      IVAL1=0
39062      IF(IMODEL.EQ.'X11')IVAL1=1
39063      IVAL2=1
39064      IF(IGUNIT.EQ.IPL1NU)IVAL2=2
39065      IF(IGUNIT.EQ.IPL2NU)IVAL2=3
39066CCCCC IF(IVAL2.EQ.1 .AND. IVAL1.EQ.1)THEN
39067CCCCC   WRITE(ICOUT,999)
39068CCCCC   CALL DPWRST('XXX','BUG ')
39069CCCCC   WRITE(ICOUT,17006)
39070C17006   FORMAT('***** WARNING: HARDWARE TEXT NOT SUPPORTED ON ',
39071CCCCC1         'CAIRO X11 DEVICE.')
39072CCCCC   CALL DPWRST('XXX','BUG ')
39073CCCCC   GOTO9000
39074CCCCC ENDIF
39075C
39076      AX=PX1
39077      AY=PY1
39078      CALL GRTRSD(AX,AY,IX,IY,ISUBN0)
39079C
39080      DO17605I=1,NCTEXT
39081        IC1=ICTEXT(I)(1:1)
39082        CALL DPCOAN(IC1,IJUNK)
39083        STRING(I)=IJUNK
3908417605 CONTINUE
39085      STRING(NCTEXT+1)=0
39086C
39087      ILAST=32
39088      DO17611I=1,80
39089        IADE(I)=-1
3909017611 CONTINUE
39091      DO17610I=32,1,-1
39092        ILAST=I
39093        IF(ICAIFN(I:I).NE.' ')GOTO17619
3909417610 CONTINUE
3909517619 CONTINUE
39096      DO17620I=1,ILAST
39097        CALL DPCOAN(ICAIFN(I:I),IJUNK)
39098        IADE(I)=IJUNK
3909917620 CONTINUE
39100      IADE(ILAST+1)=0
39101C
39102      IFONTH=0
39103      IFONTV=0
39104      IF(IJUST.EQ.'LEFT')IFONTH=0
39105      IF(IJUST.EQ.'CENT')IFONTH=1
39106      IF(IJUST.EQ.'RIGH')IFONTH=2
39107      IF(IJUST.EQ.'LJUS')IFONTH=0
39108      IF(IJUST.EQ.'CJUS')IFONTH=1
39109      IF(IJUST.EQ.'RJUS')IFONTH=2
39110      IF(IJUST.EQ.'LEBO')IFONTH=0
39111      IF(IJUST.EQ.'CEBO')IFONTH=1
39112      IF(IJUST.EQ.'RIBO')IFONTH=2
39113      IF(IJUST.EQ.'LECE')IFONTH=0
39114      IF(IJUST.EQ.'CECE')IFONTH=1
39115      IF(IJUST.EQ.'RICE')IFONTH=2
39116      IF(IJUST.EQ.'LETO')IFONTH=0
39117      IF(IJUST.EQ.'CETO')IFONTH=1
39118      IF(IJUST.EQ.'RITO')IFONTH=2
39119      IF(IJUST.EQ.'LEFT')IFONTV=1
39120      IF(IJUST.EQ.'CENT')IFONTV=1
39121      IF(IJUST.EQ.'RIGH')IFONTV=1
39122      IF(IJUST.EQ.'LJUS')IFONTV=1
39123      IF(IJUST.EQ.'CJUS')IFONTV=1
39124      IF(IJUST.EQ.'RJUS')IFONTV=1
39125      IF(IJUST.EQ.'LEBO')IFONTV=1
39126      IF(IJUST.EQ.'CEBO')IFONTV=1
39127      IF(IJUST.EQ.'RIBO')IFONTV=1
39128      IF(IJUST.EQ.'LECE')IFONTV=0
39129      IF(IJUST.EQ.'CECE')IFONTV=0
39130      IF(IJUST.EQ.'RICE')IFONTV=0
39131      IF(IJUST.EQ.'LETO')IFONTV=2
39132      IF(IJUST.EQ.'CETO')IFONTV=2
39133      IF(IJUST.EQ.'RITO')IFONTV=2
39134      IERR=0
39135C
39136      IVAL2=1
39137      IF(IGUNIT.EQ.IPL1NU)IVAL2=2
39138      IF(IGUNIT.EQ.IPL2NU)IVAL2=3
39139C
39140      AHEIG2=REAL(JHEIG2)
39141      IVAL3=1
39142      IF(ICAISL.EQ.'ITAL')IVAL3=2
39143      IVAL4=2
39144      IF(ICAIFW.EQ.'BOLD')IVAL4=2
39145      CALL CATXTH(IVAL2,STRING,AX,AY,IFONTH,IFONTV,AHEIG2,
39146     1            IADE,IVAL3,IVAL4,IERR)
39147C
39148#endif
39149      GOTO9000
39150C
39151C               ******************************************************
39152C               **  STEP 180--                                      **
39153C               **  TREAT THE WMF                            DRIVER **
39154C               ******************************************************
39155C
3915618000 CONTINUE
39157      GOTO9000
39158C
39159C               ******************************************************
39160C               **  STEP 190--                                      **
39161C               **  TREAT THE D3                             DRIVER **
39162C               ******************************************************
39163C
3916419000 CONTINUE
39165      GOTO9000
39166C
39167C               *****************
39168C               **  STEP 90--  **
39169C               **  EXIT       **
39170C               *****************
39171C
39172 9000 CONTINUE
39173      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'WRTH')THEN
39174        WRITE(ICOUT,999)
39175        CALL DPWRST('XXX','BUG ')
39176        WRITE(ICOUT,9011)
39177 9011   FORMAT('***** AT THE END       OF GRWRTH--')
39178        CALL DPWRST('XXX','BUG ')
39179        WRITE(ICOUT,9013)PX1,PY1,PXDEL,PYDEL
39180 9013   FORMAT('PX1,PY1,PXDEL,PYDEL = ',4G15.7)
39181        CALL DPWRST('XXX','BUG ')
39182        WRITE(ICOUT,9033)PXLEC,PXLECG,PYLEC,PYLECG
39183 9033   FORMAT('PXLEC,PXLECG,PYLEC,PYLECG= ',4G15.7)
39184        CALL DPWRST('XXX','BUG ')
39185        WRITE(ICOUT,9036)IC4,IC,IC1,IC2
39186 9036   FORMAT('IC4,IC,IC1,IC2 = ',A4,3(2X,A1))
39187        CALL DPWRST('XXX','BUG ')
39188        WRITE(ICOUT,9037)PXINC,PYINC,PXINC2,PYINC2
39189 9037   FORMAT('PXINC,PYINC,PXINC2,PYINC2, = ',4G15.7)
39190        CALL DPWRST('XXX','BUG ')
39191        WRITE(ICOUT,9043)NCSTR
39192 9043   FORMAT('NCSTR = ',I8)
39193        CALL DPWRST('XXX','BUG ')
39194        IF(NCSTR.LE.0)GOTO9047
39195          DO9045I=1,NCSTR
39196            CALL DPCOAN(ICSTR(I:I),IASCNE)
39197            WRITE(ICOUT,9046)I,ICSTR(I:I),IASCNE
39198 9046       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
39199            CALL DPWRST('XXX','BUG ')
39200 9045     CONTINUE
39201 9047   CONTINUE
39202        WRITE(ICOUT,9049)IBUGG4,ISUBG4,IERRG4
39203 9049   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
39204        CALL DPWRST('XXX','BUG ')
39205      ENDIF
39206C
39207      RETURN
39208      END
39209      SUBROUTINE GRWRTV(PX1,PY1,ICTEXT,NCTEXT,
39210     1                  IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
39211     1                  JPATT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILL,JCOL,
39212     1                  PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,JSIZE,
39213     1                  JHEIG2,JWIDT2,JVEGA2,JHOGA2,
39214     1                  PHEIG2,PWIDT2,PVEGA2,PHOGA2,
39215     1                  JTHICK,PTHIC2,PXLEC,PXLECG,PYLEC,PYLECG,
39216     1                  ISYMBL,ISPAC,PX99,PY99)
39217C
39218C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE, AND FOR THE STANDARD
39219C              (HARDWARE-GENERATED) FONT, GO TO THE POINT (PX1,PY1) AND
39220C              WRITE OUT THE TEXT STRING (IN A VERTICAL (DOWN) DIRECTION)
39221C              CONTAINED IN THE CHARACTER VECTOR ICTEXT(.), WHICH
39222C              CONSISTS OF NCTEXT CHARACTERS.
39223C     NOTE--THE STRING WILL BE WRITTEN DOWN BUT EACH CHARACTER WILL BE
39224C            HORIZONTAL.  THIS IS A REFLECTION OF THE FACT THAT TEKTRONIX
39225C            HARDWARE-GENERATED SYMBOLS SOULD NOT (ON 4014, ETC.) BE
39226C            ROTATED.  THE CODE IN THIS SUBROUTINE COULD BE UPDATED TO
39227C            TAKE ADVANTAGE OF THE FACT THAT SOME DEVICES (E.G., HP AND
39228C            ZETA) CAN ROTATE CHARACTERS.
39229C     NOTE--PX1 AND PY1 ARE IN STANDARDIZED COORDINATES
39230C           THAT IS, EACH IS 0.0 TO 100.0.
39231C     NOTE--THE SUBSECTION    RWIND    HAS BEEN EXTRACTED
39232C           OUT OF     PLOT CONTROL COMMON   .
39233C           THIS (AND GRWRTH) ARE THE ONLY SUBROUTINES WHERE
39234C           THIS SUB-EXTRACTION HAS BEEN DONE.
39235C
39236C     WRITTEN BY--JAMES J. FILLIBEN
39237C                 STATISTICAL ENGINEERING DIVISION
39238C                 INFORMATION TECHNOLOGY LABORATORY
39239C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
39240C                 GAITHERSBURG, MD 20899-8980
39241C                 PHONE--301-975-2855
39242C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
39243C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
39244C     LANGUAGE--ANSI FORTRAN (1977)
39245C     VERSION NUMBER--83.6
39246C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
39247C     UPDATED         --JANUARY  1989.  SUN (BY BILL ANDERSON)
39248C                                      DRIVER OBSOLETE
39249C     UPDATED         --JANUARY  1989.  POSTSCRIPT (BY ALAN HECKERT)
39250C     UPDATED         --JANUARY  1989.  CGM (BY ALAN HECKERT)
39251C     UPDATED         --JANUARY  1989.  QMS QUIC (BY ALAN HECKERT)
39252C     UPDATED         --JANUARY  1989.  CALCOMP (BY ALAN HECKERT)
39253C     UPDATED         --JANUARY  1989.  ZETA (BY ALAN HECKERT)
39254C     UPDATED         --APRIL    1989.  SOFT-CODE BACKSLASH FOR UNIX
39255C     UPDATED         --OCTOBER  1989.  RWIND CORRECTION (NELSON HSU)
39256C     UPDATED         --MARCH    1990.  X11 (BY ALAN HECKERT)
39257C     UPDATED         --JULY     1990.  PACK HP2622 OUTPUT
39258C     UPDATED         --MARCH    1991.  PACK REGIS OUTPUT
39259C     UPDATED         --MAY      1991. RENUMBER TOP BRANCHES (JJF)
39260C     UPDATED         --MAY      1991. VGA/TURBOC DRIVER (JJF)
39261C                                      DRIVER OBSOLETE
39262C     UPDATED         --MAY      1991. FIX POSTSCRIPT CHAR. INDICES
39263C     UPDATED         --OCTOBER  1991.  POSTSCRIPT FONTS (ALAN)
39264C     UPDATED         --JUNE     1994. MAJOR MODIFICATIONS: (ALAN)
39265C                                      1) FIX JUSTIFICATION LOGIC
39266C                                      2) POSTSCRIPT AND X11 DO JUST IN
39267C                                         DEVICE DRIVER, SOME SPECIAL
39268C                                         HANDLING REQUIRED.
39269C                                      3) DISTINGUISH ROTATABLE AND
39270C                                         NON-ROTATABLE CHARACTERS
39271C                                      4) SCALE FACTOR (FOR MULTIPLOT
39272C                                         CASE) FOR UNROTATED DEVICES
39273C     UPDATED         --SEPTEMBER 1994. FIX TURBO-C SECTION
39274C                                       BAD C-SIDE MULTIPLOTTING (SCALING)
39275C     UPDATED         --JANUARY   1995. FIX FRONT END Y1LABEL
39276C     UPDATED         --SEPTEMBER 1995. RETROACTIVE JIM/ALAN MERGE
39277C     UPDATED         --SEPTEMBER 1995. FIX TURBO-C SECTION
39278C                            BAD C-SIDE MULTIPLOTTING (SCALING) (AGAIN)
39279C     UPDATED         --SEPTEMBER 1995. REFIX TURBO-C SECTION
39280C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
39281C                                      OLD, CALCOMP STYLE
39282C                                      DRIVER OBSOLETE
39283C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
39284C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
39285C                                      USE BILL MITCHELLS OPENGL
39286C                                      BINDING FOR FORTRAN
39287C     UPDATED         --OCTOBER  1996. GKS (ALAN)
39288C                                      CODED, NOT TESTED
39289C     UPDATED         --OCTOBER  1996. BINARY CGM (ALAN)
39290C                                      PLACEHOLDER FOR NOW
39291C     UPDATED         --OCTOBER  1996. DISPLAY POSTSCRIPT (ALAN)
39292C                                      PLACEHOLDER FOR NOW
39293C     UPDATED         --OCTOBER  1997. LAHEY INTERACTOR (ALAN)
39294C     UPDATED         --DECEMBER 1997. GENERAL CODED FOR GUI
39295C     UPDATED         --JULY     1998. LAHEY WINTERACTOR
39296C     UPDATED         --JUNE     2000. GD (FOR JPEG, PNG, WINDOWS BMP)
39297C     UPDATED         --JUNE     2000. MACINTOSH
39298C                                      PLACEHOLDER FOR NOW
39299C     UPDATED         --JUNE     2000. PC PRINTER
39300C                                      PLACEHOLDER FOR NOW
39301C     UPDATED         --MARCH    2002. LATEX (USING EEPIC)
39302C                                      PLACEHOLDER FOR NOW
39303C     UPDATED         --MARCH    2002. SVG (SCALABLE VECTOR GRAPHICS)
39304C     UPDATED         --MARCH    2005. SUPPORT FOR AQUATERM
39305C     UPDATED         --FEBRUARY 2006. IMPLEMENT LATEX DRIVER
39306C     UPDATED         --FEBRUARY 2009. SUBSCRIPT, SUPERSCRIPTS, GREEK
39307C                                      CHARACTERS FOR POSTSCRIPT DEVICE
39308C     UPDATED         --APRIL    2009. IMPLEMENT LIBPLOT DRIVER
39309C     UPDATED         --APRIL    2009. REMOVE PCL, RAMTEK, PRIN, XXXX DRIVERS
39310C                                      (THESE WERE NEVER ACTUALLY IMPLEMENTED)
39311C     UPDATED         --FEBRUARY  2012 "<" AND ">" IN STRINGS FOR SVG
39312C     UPDATED         --JULY      2015 ISSUE WITH TEXT FOR SVG DRIVER
39313C                                      WHEN USING THE CHROME BROWSER
39314C     UPDATED         --SEPTEMBER 2015 FIX GREYSCALE COLOR FOR SVG
39315C     UPDATED         --NOVEMBER  2015 FOR SVG, CHECK FOR "&" IN TEXT
39316C     UPDATED         --OCTOBER  2016. ADD PRE-PROCESSOR DIRECTIVES
39317C     UPDATED         --OCTOBER  2016. ADD TEMPLATES FOR SEVERL FUTURE
39318C                                      GRAPHICS DEVICES
39319C
39320C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
39321C
39322#ifdef HAVE_WININTERACTER
39323      USE WINTERACTER
39324#endif
39325#ifdef HAVE_INTERACTER
39326      USE INTERACTER
39327#endif
39328#ifdef HAVE_QWIN
39329CQWIN USE DFLIB
39330      USE IFQWIN
39331      TYPE (XYCOORD) XY
39332CCCCC TYPE (FONTINFO) MSFONT
39333      TYPE (WINDOWCONFIG)   DPSCREEN
39334      CHARACTER*4 QWSCRN
39335      COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN
39336#endif
39337C
39338      INTEGER IGKSID
39339      INTEGER IGKSWK
39340      INTEGER IGKSTY
39341      COMMON/IGKS/IGKSID,IGKSWK,IGKSTY
39342C
39343      CHARACTER*4 ICTEXT
39344#ifdef HAVE_LIBPLOT
39345      CHARACTER*4 ICTEX2(255)
39346#endif
39347      CHARACTER*4 IPATT
39348      CHARACTER*4 IFONT
39349      CHARACTER*4 ICASE
39350      CHARACTER*4 IJUST
39351      CHARACTER*4 IDIR
39352      CHARACTER*4 IFILL
39353      CHARACTER*4 ICOL
39354      CHARACTER*24 ISYMBL
39355      CHARACTER*4 ISPAC
39356      CHARACTER*4 IC4
39357      CHARACTER*1 IC
39358      CHARACTER*1 IC1
39359      CHARACTER*1 IC2
39360      CHARACTER*130 ICSTR
39361      CHARACTER*130 ICSTR2
39362      CHARACTER*130 ICSTR3
39363      CHARACTER*4 ISUBRO
39364      CHARACTER*4 ISUBN0
39365      CHARACTER*4 IERROR
39366      CHARACTER*4 ICTEMP
39367      CHARACTER*1 ICARAT
39368      CHARACTER*1 IQUOTE
39369      CHARACTER*2 ICJUNK
39370C
39371      DIMENSION ICTEXT(*)
39372      INTEGER STRING(130)
39373      INTEGER IADE(80)
39374      CHARACTER*4 IJUSTH
39375      CHARACTER*4 IJUSTV
39376#ifdef HAVE_LAHEY_CALCOMP
39377      CHARACTER*40 CLAHEY
39378      REAL RLAHEY(7)
39379      INTEGER ILAHEY(9)
39380      DIMENSION IHOLL(33)
39381#endif
39382#ifdef HAVE_CALCOMP
39383      DIMENSION IHOLL2(33)
39384#endif
39385#ifdef HAVE_ZETA
39386      DIMENSION IHOLL3(33)
39387#endif
39388C
39389      PARAMETER (MAXSYM=25)
39390      INTEGER ISTARV(MAXSYM)
39391      INTEGER ISTOPV(MAXSYM)
39392      INTEGER IFONTP(MAXSYM)
39393      REAL SIZEV(MAXSYM)
39394      REAL OFFSEV(MAXSYM)
39395C
39396C-----COMMON----------------------------------------------------------
39397C
39398      INCLUDE 'DPCOPA.INC'
39399      INCLUDE 'DPCOGR.INC'
39400      INCLUDE 'DPCONP.INC'
39401      INCLUDE 'DPCOBE.INC'
39402      INCLUDE 'DPCOST.INC'
39403      INCLUDE 'DPCODV.INC'
39404      INCLUDE 'DPCOF2.INC'
39405      COMMON /RWIND/
39406     1PWXMIN,PWXMAX,PWYMIN,PWYMAX,PWZMIN,PYZMAX,
39407     1WWXMIN,WWXMAX,WWYMIN,WWYMAX,WWZMIN,WWZMAX
39408C
39409      PARAMETER(MAXCLR=89)
39410      INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR)
39411C
39412      INCLUDE 'DPCOCT.INC'
39413      INCLUDE 'DPCOP2.INC'
39414C
39415C-----START POINT-----------------------------------------------------
39416C
39417      IERROR='OFF'
39418      ISUBN0='WRTV'
39419      ISUBRO=ISUBG4
39420      IC4='-999'
39421      IC='-'
39422      IC1='-'
39423      IC2='-'
39424C
39425      NCSTR=(-999)
39426C
39427      PXDEL=(-999.0)
39428      PYDEL=(-999.0)
39429      AFACT=(-999.0)
39430C
39431      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'WRTV')THEN
39432        WRITE(ICOUT,999)
39433  999   FORMAT(1X)
39434        CALL DPWRST('XXX','BUG ')
39435        WRITE(ICOUT,51)
39436   51   FORMAT('***** AT THE BEGINNING OF GRWRTV--')
39437        CALL DPWRST('XXX','BUG ')
39438        WRITE(ICOUT,53)PX1,PY1,PX99,PY99
39439   53   FORMAT('PX1,PY1,PX99,PY99 = ',4G15.7)
39440        CALL DPWRST('XXX','BUG ')
39441        WRITE(ICOUT,55)NCTEXT,JSIZE,JPATT,JFONT,JCASE,JJUST,JDIR
39442   55   FORMAT('NCTEXT,JSIZE,JPATT,JFONT,JCASE,JJUST,JDIR = ',7I5)
39443        CALL DPWRST('XXX','BUG ')
39444        WRITE(ICOUT,59)IPATT,IFONT,ICASE,IJUST,IDIR
39445   59   FORMAT('IPATT,IFONT,ICASE,IJUST,IDIR = ',4(A4,2X),A4)
39446        CALL DPWRST('XXX','BUG ')
39447        WRITE(ICOUT,56)(ICTEXT(I),I=1,MIN(25,NCTEXT))
39448   56   FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
39449        CALL DPWRST('XXX','BUG ')
39450        WRITE(ICOUT,64)ANGLE,ANGLE2
39451   64   FORMAT('ANGLE,ANGLE2= ',2G15.7)
39452        CALL DPWRST('XXX','BUG ')
39453        WRITE(ICOUT,65)IFILL,ICOL,JFILL,JCOL
39454   65   FORMAT('IFILL,ICOL,JFILL,JCOL = ',2(A4,2X),2I8)
39455        CALL DPWRST('XXX','BUG ')
39456        WRITE(ICOUT,67)PHEIGH,JHEIG2,PHEIG2
39457   67   FORMAT('PHEIGH,JHEIG2,PHEIG2= ',G15.7,I8,G15.7)
39458        CALL DPWRST('XXX','BUG ')
39459        WRITE(ICOUT,68)PWIDTH,JWIDT2,PWIDT2
39460   68   FORMAT('PWIDTH,JWIDT2,PWIDT2= ',G15.7,I8,G15.7)
39461        CALL DPWRST('XXX','BUG ')
39462        WRITE(ICOUT,69)PVEGAP,JVEGA2,PVEGA2
39463   69   FORMAT('PVEGAP,JVEGA2,PVEGA2= ',G15.7,I8,G15.7)
39464        CALL DPWRST('XXX','BUG ')
39465        WRITE(ICOUT,70)PHOGAP,JHOGA2,PHOGA2
39466   70   FORMAT('PHOGAP,JHOGA2,PHOGA2= ',G15.7,I8,G15.7)
39467        CALL DPWRST('XXX','BUG ')
39468        WRITE(ICOUT,71)PTHICK,JTHICK,PTHIC2
39469   71   FORMAT('PTHICK,JTHICK,PTHIC2= ',G15.7,I8,G15.7)
39470        CALL DPWRST('XXX','BUG ')
39471        WRITE(ICOUT,73)PXLEC,PXLECG,PYLEC,PYLECG
39472   73   FORMAT('PXLEC,PXLECG,PYLEC,PYLECG = ',4G15.7)
39473        CALL DPWRST('XXX','BUG ')
39474        WRITE(ICOUT,75)ISPAC,ISYMBL
39475   75   FORMAT('ISPAC,ISYMBL = ',A4,2X,A24)
39476        CALL DPWRST('XXX','BUG ')
39477        WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
39478   79   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
39479        CALL DPWRST('XXX','BUG ')
39480      ENDIF
39481C
39482C               ******************************************************
39483C               **  STEP XX--                                       **
39484C               **  COMPUTE NEW START POINTS DEPENDING              **
39485C               **  ON THE JUSTIFICATION                            **
39486C               **  NOTE THAT TEKTRONIX CHARACTERS CANNOT BE ROTATED**
39487C               **  AND SO THE SETTINGS ARE SOMEWHAT STRANGE        **
39488C               **  (HEIGHT FOR WIDTH AND WIDTH FOR HEIGHT)         **
39489C               ******************************************************
39490CCCCC JUNE 1994.  FIX JUSTIFICATION IN FOLLOWING 2 WAYS:
39491CCCCC             1) DISTINGUISH BETWEEN THOSE DEVICES THAT ROTATE
39492CCCCC                CHARACTERS AND THOSE THAT DO NOT.
39493CCCCC             2) RETHINK LOGIC SO THAT HORIZONTAL IS STILL
39494CCCCC                LEFT TO RIGHT AND VERTICAL IS STILL TOP TO
39495CCCCC                BOTTOM.
39496C
39497      IF(IMANUF.EQ.'POST')GOTO801
39498      IF(IMANUF.EQ.'CALC')GOTO801
39499      IF(IMANUF.EQ.'ZETA')GOTO801
39500      IF(IMANUF.EQ.'SVG ')GOTO801
39501      IF(IMANUF.EQ.'LATE')GOTO998
39502      GOTO901
39503C
39504C      ***************************************
39505C      **  ROTATED DEVICES                  **
39506C      ***************************************
39507C
39508  801 CONTINUE
39509      IF(IJUST.EQ.'LEFT')GOTO820
39510      IF(IJUST.EQ.'CENT')GOTO850
39511      IF(IJUST.EQ.'RIGH')GOTO880
39512C
39513      IF(IJUST.EQ.'LJUS')GOTO820
39514      IF(IJUST.EQ.'CJUS')GOTO850
39515      IF(IJUST.EQ.'RJUS')GOTO880
39516C
39517      IF(IJUST.EQ.'LEBO')GOTO810
39518      IF(IJUST.EQ.'CEBO')GOTO820
39519      IF(IJUST.EQ.'RIBO')GOTO830
39520C
39521      IF(IJUST.EQ.'LECE')GOTO840
39522      IF(IJUST.EQ.'CECE')GOTO850
39523      IF(IJUST.EQ.'RICE')GOTO860
39524C
39525      IF(IJUST.EQ.'LETO')GOTO870
39526      IF(IJUST.EQ.'CETO')GOTO880
39527      IF(IJUST.EQ.'RITO')GOTO890
39528C
39529      GOTO810
39530C
39531  810 CONTINUE
39532      PXINC=-PHEIG2
39533      PYINC=0.0
39534      GOTO995
39535C
39536  820 CONTINUE
39537      PXINC=-PHEIG2/2.0
39538      PYINC=0.0
39539      GOTO995
39540C
39541  830 CONTINUE
39542      PXINC=0.0
39543      PYINC=0.0
39544      GOTO995
39545C
39546  840 CONTINUE
39547      PXINC=-PHEIG2
39548      PYINC=PXLECG/2.0
39549      GOTO995
39550C
39551  850 CONTINUE
39552      PXINC=-PHEIG2/2.0
39553      PYINC=PXLECG/2.0
39554      GOTO995
39555C
39556  860 CONTINUE
39557      PXINC=0.0
39558      PYINC=PXLECG/2.0
39559      GOTO995
39560C
39561  870 CONTINUE
39562      PXINC=-PHEIG2
39563      PYINC=PXLECG
39564      GOTO995
39565C
39566  880 CONTINUE
39567      PXINC=-PHEIG2/2.0
39568      PYINC=PXLECG
39569      GOTO995
39570C
39571  890 CONTINUE
39572      PXINC=0.0
39573      PYINC=PXLECG
39574      GOTO995
39575C
39576C
39577C      ***************************************
39578C      **  UNROTATED DEVICES                **
39579C      ***************************************
39580CCCCC JUNE 1994.  FOLLOWING SECTION REWRITTEN.
39581C
39582  901 CONTINUE
39583CCCCC JULY, 1996.  ADD SETTINGS FOR IJUSTH, IJUSTV IN FOLLOWING BLOCK
39584      IJUSTH='LEFT'
39585      IJUSTV='BOTT'
39586C
39587CCCCC IF(IJUST.EQ.'LEFT')GOTO910
39588CCCCC IF(IJUST.EQ.'CENT')GOTO920
39589CCCCC IF(IJUST.EQ.'RIGH')GOTO930
39590      IF(IJUST.EQ.'LEFT')GOTO920
39591      IF(IJUST.EQ.'CENT')GOTO950
39592      IF(IJUST.EQ.'RIGH')GOTO980
39593C
39594CCCCC IF(IJUST.EQ.'LJUS')GOTO910
39595CCCCC IF(IJUST.EQ.'CJUS')GOTO920
39596CCCCC IF(IJUST.EQ.'RJUS')GOTO930
39597      IF(IJUST.EQ.'LJUS')GOTO920
39598      IF(IJUST.EQ.'CJUS')GOTO950
39599      IF(IJUST.EQ.'RJUS')GOTO980
39600C
39601      IF(IJUST.EQ.'LEBO')GOTO910
39602      IF(IJUST.EQ.'CEBO')GOTO920
39603      IF(IJUST.EQ.'RIBO')GOTO930
39604C
39605      IF(IJUST.EQ.'LECE')GOTO940
39606      IF(IJUST.EQ.'CECE')GOTO950
39607      IF(IJUST.EQ.'RICE')GOTO960
39608C
39609      IF(IJUST.EQ.'LETO')GOTO970
39610      IF(IJUST.EQ.'CETO')GOTO980
39611      IF(IJUST.EQ.'RITO')GOTO990
39612C
39613      GOTO910
39614C
39615  910 CONTINUE
39616      PXINC=0.0
39617      PYINC=-PYLEC+PHEIG2
39618      IJUSTH='LEFT'
39619      IJUSTV='TOP '
39620      GOTO995
39621C
39622  920 CONTINUE
39623CCCCC PXINC=0.0
39624CCCCC PYINC=-(PYLEC/2.0)+PHEIG2
39625      PXINC=PWIDT2/2.0
39626      PYINC=-PYLEC+PHEIG2
39627      IJUSTH='CENT'
39628      IJUSTV='TOP '
39629      GOTO995
39630C
39631  930 CONTINUE
39632CCCCC PXINC=0.0
39633CCCCC PYINC=PHEIG2
39634      PXINC=PWIDT2
39635      PYINC=-PYLEC+PHEIG2
39636      IJUSTH='RIGH'
39637      IJUSTV='TOP '
39638      GOTO995
39639C
39640  940 CONTINUE
39641CCCCC PXINC=PWIDT2/2.0
39642CCCCC PYINC=-PYLEC+PHEIG2
39643      PXINC=0.0
39644      PYINC=-(PYLEC/2.0)+PHEIG2
39645      IJUSTH='LEFT'
39646      IJUSTV='CENT'
39647      GOTO995
39648C
39649  950 CONTINUE
39650CCCCC PXINC=PWIDT2/2.0
39651      PXINC=PWIDT2/2.0
39652      PYINC=-(PYLEC/2.0)+PHEIG2
39653      IJUSTH='CENT'
39654      IJUSTV='CENT'
39655      GOTO995
39656C
39657  960 CONTINUE
39658CCCCC PXINC=PWIDT2/2.0
39659CCCCC PYINC=PHEIG2
39660      PXINC=PWIDT2
39661      PYINC=-(PYLEC/2.0)+PHEIG2
39662      IJUSTH='RIGH'
39663      IJUSTV='CENT'
39664      GOTO995
39665C
39666  970 CONTINUE
39667CCCCC PXINC=PWIDT2
39668CCCCC PYINC=-PYLEC+PHEIG2
39669      PXINC=0.0
39670      PYINC=PHEIG2
39671      IJUSTH='LEFT'
39672      IJUSTV='BOTT'
39673      GOTO995
39674C
39675  980 CONTINUE
39676CCCCC PXINC=PWIDT2
39677CCCCC PYINC=-(PYLEC/2.0)+PHEIG2
39678      PXINC=PWIDT2/2.0
39679      PYINC=PHEIG2
39680      IJUSTH='CENT'
39681      IJUSTV='BOTT'
39682      GOTO995
39683C
39684  990 CONTINUE
39685      PXINC=PWIDT2
39686      PYINC=PHEIG2
39687      IJUSTH='RIGH'
39688      IJUSTV='BOTT'
39689      GOTO995
39690C
39691  995 CONTINUE
39692CCCCC PX1P=PX1-PXINC
39693CCCCC PY1P=PY1-PYINC
39694CCCCC JUNE 1994.  DEFINE SCALE FACTOR
39695      AFACT=100.0/(PWXMAX-PWXMIN)
39696CCCCC PXINC2=PXINC*(100.0/(PWXMAX-PWXMIN))
39697CCCCC PYINC2=PYINC*(100.0/(PWYMAX-PWYMIN))
39698      PXINC2=PXINC*AFACT
39699      PYINC2=PYINC*AFACT
39700      PX1P=PX1-PXINC2
39701      PY1P=PY1-PYINC2
39702CCCCC JUNE 1994.  FOR POSTSCRIPT, Y JUSTIFICATION DONE IN DRIVER.
39703CCCCC             X COORDINATE CONTAINS BOTH CHARACTER AND GAP, USE A
39704CCCCC             FUDGE FACTOR TO COMPENSATE (PROBABLY NOT TOTALLY
39705CCCCC             ACCURATE, BUT BETTER THAN NO ADJUSTMENT).
39706      IF(IMANUF.EQ.'POST')THEN
39707        PY1P=PY1
39708        PX1P=PX1-0.75*PXINC2
39709      ENDIF
39710C
39711C
39712C               *************************
39713C               **  STEP XX--          **
39714C               **  COMPUTE END POINT  **
39715C               *************************
39716C
39717      ANCTEX=NCTEXT
39718      PX99=PX1P
39719      PY99=PY1P-ANCTEX*AFACT*(PHEIG2+PVEGA2)
39720C
39721  998 CONTINUE
39722
39723C               ********************************************
39724C               **  STEP 1--                              **
39725C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
39726C               **  AND THE MODEL                         **
39727C               ********************************************
39728C
39729      IF(IMANUF.EQ.'QWIN')THEN
39730        GOTO4700
39731      ELSEIF(IMANUF.EQ.'POST')THEN
39732        GOTO8600
39733      ELSEIF(IMANUF.EQ.'X11 ')THEN
39734        GOTO9600
39735      ELSEIF(IMANUF.EQ.'AQUA')THEN
39736        GOTO13500
39737      ELSEIF(IMANUF.EQ.'GENE')THEN
39738        IF(IMODEL.EQ.'CODE')GOTO3200
39739        IF(IMODEL.EQ.'CGM')GOTO3300
39740        IF(IMODEL.EQ.'CGMB')GOTO3400
39741        GOTO3100
39742      ELSEIF(IMANUF.EQ.'SVG ')THEN
39743        GOTO16000
39744      ELSEIF(IMANUF.EQ.'GD  ')THEN
39745        GOTO12000
39746      ELSEIF(IMANUF.EQ.'LATE')THEN
39747        GOTO15000
39748      ELSEIF(IMANUF.EQ.'CAIR')THEN
39749        GOTO17000
39750      ELSEIF(IMANUF.EQ.'D3  ')THEN
39751        GOTO19000
39752      ELSEIF(IMANUF.EQ.'WMF ')THEN
39753        GOTO18000
39754      ELSEIF(IMANUF.EQ.'OPGL')THEN
39755        GOTO4800
39756      ELSEIF(IMANUF.EQ.'TEKT')THEN
39757        GOTO1100
39758      ELSEIF(IMANUF.EQ.'HP')THEN
39759        IF(IMODEL.EQ.'7221')GOTO2100
39760        IF(IMODEL.EQ.'2622')GOTO2300
39761        IF(IMODEL.EQ.'2623')GOTO2300
39762        IF(IMODEL.EQ.'2627')GOTO2300
39763        IF(IMODEL.EQ.'2647')GOTO2300
39764        GOTO2200
39765      ELSEIF(IMANUF.EQ.'LIBP')THEN
39766        GOTO2600
39767      ELSEIF(IMANUF.EQ.'REGI')THEN
39768        GOTO8100
39769      ELSEIF(IMANUF.EQ.'GKS ')THEN
39770        GOTO11000
39771      ELSEIF(IMANUF.EQ.'LAHE')THEN
39772        IF(IMODEL.EQ.'INTE')GOTO4900
39773        IF(IMODEL.EQ.'WINT')GOTO4950
39774        GOTO4600
39775      ELSEIF(IMANUF.EQ.'ABSO' .OR. IMANUF.EQ.'PLPL')THEN
39776        GOTO13000
39777      ELSEIF(IMANUF.EQ.'QUIC')THEN
39778        GOTO9100
39779      ELSEIF(IMANUF.EQ.'CALC')THEN
39780        GOTO4100
39781      ELSEIF(IMANUF.EQ.'ZETA')THEN
39782        GOTO5100
39783      ELSEIF(IMANUF.EQ.'TURB')THEN
39784        GOTO10000
39785      ELSEIF(IMANUF.EQ.'SUN ')THEN
39786        GOTO6600
39787      ENDIF
39788      GOTO9000
39789C
39790C               ******************************************************
39791C               **  STEP 11--                                       **
39792C               **  TREAT THE TEKTRONIX 4014 (ETC.) CASE            **
39793C               ******************************************************
39794C
39795 1100 CONTINUE
39796      IF(NUMHPP.GE.4000)IFACTO=1
39797      IF(NCTEXT.GT.0)THEN
39798        DO1110I=1,NCTEXT
39799          ICSTR(1:1)=IGSC
39800          NCSTR=1
39801          IF(I.GE.2)PY1P=PY1P-AFACT*(PHEIG2+PVEGA2)
39802          CALL GRTRSD(PX1P,PY1P,IX1P,IY1P,ISUBN0)
39803          CALL TKTRPT(IX1P,IY1P,IFACTO,ICSTR,NCSTR,ISUBN0)
39804          NCSTR=NCSTR+1
39805          ICSTR(NCSTR:NCSTR)=IUSC
39806          NCSTR=NCSTR+1
39807          ICTEMP=ICTEXT(I)
39808          ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
39809          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
39810 1110   CONTINUE
39811      ENDIF
39812      GOTO9000
39813C
39814C               ******************************************************
39815C               **  STEP 21--                                       **
39816C               **  TREAT THE HEWLETT-PACKARD 7221 CASE             **
39817C               **  (MULTI-COLOR PENPLOTTER)                        **
39818C               **  TO WRITE A "VERTICAL" TEXT STRING--             **
39819C               **  USE THE LOWER CASE P (= MOVE) INSTRUCTION       **
39820C               **  AND PACKED BINARY COORDINATES,                  **
39821C               **  AND THE TILDA SINGLE (RT-LEFT) QUOTE (= INVOKE  **
39822C               **  LABEL MODE) I AND THE DESIRED TEXT STRING,      **
39823C               **  AND ETX TO DENOTE THE END OF TEXT STRING,       **
39824C               **  (WITH TRAILING RIGHT CURLY BRACKET WHICH IS THE **
39825C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
39826C               **  REFERENCE--HP 7221A GRAPHICS PLOTTER            **
39827C               **             OPERATING AND PROGRAMMING MANUAL,    **
39828C               **             PAGE 80-85, 253-254.                 **
39829C               **             PAGE 111 AND 112.                    **
39830C               **  NOTE--THE STRING IS "VERTICAL" ONLY IN SENSE    **
39831C               **        THAT THE STRING WILL STEP DOWN VERTICALLY **
39832C               **        BUT EACH CHARACTER WILL BE HORIZONTAL.    **
39833C               **        THIS CODE COULD BE IMPROVED TO TAKE       **
39834C               **        ADVANTAGE OF THE FACT THAT                **
39835C               **        THAT HP CAN ROTATE ITS CHARACTERS.        **
39836C               ******************************************************
39837C
39838 2100 CONTINUE
39839C
39840      IF(NCTEXT.GT.0)THEN
39841        DO2110I=1,NCTEXT
39842          ICSTR(1:1)='p'
39843          NCSTR=1
39844          IF(I.GE.2)PY1P=PY1P-AFACT*(PHEIG2+PVEGA2)
39845          CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
39846          CALL HPTRPT(IX,IY,ICSTR,NCSTR,ISUBN0)
39847          NCSTR=NCSTR+1
39848          ICSTR(NCSTR:NCSTR)='}'
39849          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
39850          ICSTR(1:2)='~'''
39851          ICTEMP=ICTEXT(I)
39852          ICSTR(3:3)=ICTEMP(1:1)
39853          ICSTR(4:4)=IETXC
39854          NCSTR=4
39855          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
39856 2110   CONTINUE
39857      ENDIf
39858      GOTO9000
39859C
39860C               ******************************************************
39861C               **  STEP 22--                                       **
39862C               **  TREAT THE HEWLETT-PACKARD HP-GL CASES           **
39863C               **  (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS)     **
39864C               **  (MULTI-COLOR PENPLOTTERS)                       **
39865C               **  TO WRITE A VERTICAL TEXT STRING--               **
39866C               **  USE THE PU (= PEN UP) INSTRUCTION               **
39867C               **  AND THE PA (= PLOT ABSOLUTE) INSTRUCTION        **
39868C               **  ALONG WITH INTEGER COORDINATES,                 **
39869C               **  AND THE LB (= LABEL) INSTRUCTION                **
39870C               **  AND THE DESIRED TEXT STRING,                    **
39871C               **  AND ETX TO DENOTE THE END OF TEXT STRING,       **
39872C               **  (WITH   TRAILING SEMI-COLONS WHICH ARE THE      **
39873C               **  DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR).   **
39874C               **  REFERENCE--HP 9872C GRAPHICS PLOTTER            **
39875C               **             OPERATING AND PROGRAMMING MANUAL,    **
39876C               **             PAGE 62, 143.                        **
39877C               **             PAGE 65-67, 143.                     **
39878C               **             PAGE 75, 141.                        **
39879C               **  NOTE--THE STRING IS "VERTICAL" ONLY IN SENSE    **
39880C               **        THAT THE STRING WILL STEP DOWN VERTICALLY **
39881C               **        BUT EACH CHARACTER WILL BE HORIZONTAL.    **
39882C               **        THIS CODE COULD BE IMPROVED TO TAKE       **
39883C               **        ADVANTAGE OF THE FACT THAT                **
39884C               **        THAT HP CAN ROTATE ITS CHARACTERS.        **
39885C               ******************************************************
39886C
39887 2200 CONTINUE
39888C
39889      IF(NCTEXT.GT.0)THEN
39890        DO2210I=1,NCTEXT
39891          IF(I.GE.2)PY1P=PY1P-AFACT*(PHEIG2+PVEGA2)
39892          CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
39893          ICSTR(1:5)='PU;PA'
39894          NCSTR=5
39895          NCHTOT=5
39896          CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
39897          ICSTR(11:11)=','
39898          NCSTR=11
39899          CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
39900          ICSTR(17:17)=';'
39901          NCSTR=17
39902          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
39903          ICSTR(1:2)='LB'
39904          NCSTR=2
39905          ICTEMP=ICTEXT(I)
39906          ICSTR(3:3)=ICTEMP(1:1)
39907          ICSTR(4:4)=IETXC
39908          ICSTR(5:5)=';'
39909          NCSTR=5
39910          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
39911 2210   CONTINUE
39912      ENDIF
39913      GOTO9000
39914C
39915C               **********************************************************
39916C               **  STEP 23--                                           **
39917C               **  TREAT THE HEWLETT-PACKARD HP-2622 CASES             **
39918C               **  (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS)  **
39919C               **  (MONOCHROME DISPLAY TERMINALS)                      **
39920C               **  REFERENCE--HP 2322C GRAPHICS PLOTTER                **
39921C               **             REFERENCE MANUAL,                        **
39922C               **             PAGE 10-12, 10-13, 10-21.
39923C               **********************************************************
39924C
39925C     JULY, 1990.  PACK OUTPUT (REQUESTED BY MIKE KELLY FOR BETTER
39926C                  PERFORMANCE ON THE HP EMULATOR PACKAGE).  NOTE THAT
39927C                  THE TEXT STRING TERMINATES WITH A  , SO ONLY PUT 1
39928C                  LINE AT A TIME.  HOWEVER, THIS STILL REDUCES NUMBER
39929C                  OF LINES BY HALF.
39930C
39931 2300 CONTINUE
39932      IF(NCTEXT.GT.0)THEN
39933        NCSTR=0
39934        DO2310I=1,NCTEXT
39935          IF(I.GE.2)PY1P=PY1P-AFACT*2.0*(PHEIG2+PVEGA2)
39936          CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
39937          IF(NCSTR.GT.84)THEN
39938            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
39939            NCSTR=0
39940          ENDIF
39941          NCSTR=NCSTR+1
39942          ICSTR(NCSTR:NCSTR)=IESCC
39943          NCSTR=NCSTR+1
39944          NCSTR2=NCSTR+2
39945          ICSTR(NCSTR:NCSTR2)='*pa'
39946          NCSTR=NCSTR2
39947          NCHTOT=5
39948          CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
39949          NCSTR=NCSTR+1
39950          ICSTR(NCSTR:NCSTR)=','
39951          CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
39952          NCSTR=NCSTR+1
39953          ICSTR(NCSTR:NCSTR)='Z'
39954C
39955          NCSTR=NCSTR+1
39956          ICSTR(NCSTR:NCSTR)=IESCC
39957          NCSTR=NCSTR+1
39958          NCSTR2=NCSTR+1
39959          ICSTR(NCSTR:NCSTR2)='*l'
39960          NCSTR=NCSTR2+1
39961          ICTEMP=ICTEXT(I)
39962          ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
39963          NCSTR=NCSTR+1
39964          ICSTR(NCSTR:NCSTR)=ICRC
39965C
39966 2310   CONTINUE
39967        IF(NCSTR.GT.0)CALL GRWRST(ICSTR,NCSTR,ISUBN0)
39968      ENDIF
39969      GOTO9000
39970C
39971C               ******************************************************
39972C               **  STEP 26--                                       **
39973C               **  TREAT THE UNIX LIBPLOT          CASE            **
39974C               ******************************************************
39975C
39976 2600 CONTINUE
39977#ifdef HAVE_LIBPLOT
39978C
39979      CALL LIBPTR(ICTEXT,NCTEXT,ICTEX2,NCTEX2,ICASE,ISUBRO,IBUGG4)
39980      DO2605I=1,NCTEX2
39981        IC1=ICTEX2(I)(1:1)
39982        CALL DPCOAN(IC1,IJUNK)
39983        STRING(I)=IJUNK
39984 2605 CONTINUE
39985      STRING(NCTEX2+1)=0
39986C
39987      ILAST=80
39988      DO2610I=80,1,-1
39989        ILAST=I
39990        IF(ILPLFN(I:I).NE.' ')GOTO2619
39991 2610 CONTINUE
39992 2619 CONTINUE
39993      DO2620I=1,ILAST
39994        CALL DPCOAN(ILPLFN(I:I),IJUNK)
39995        IADE(I)=IJUNK
39996 2620 CONTINUE
39997      IADE(ILAST+1)=0
39998C
39999      IFONTH=0
40000      IFONTV=0
40001      IF(IJUST.EQ.'LEFT')IFONTH=0
40002      IF(IJUST.EQ.'CENT')IFONTH=1
40003      IF(IJUST.EQ.'RIGH')IFONTH=2
40004      IF(IJUST.EQ.'LJUS')IFONTH=0
40005      IF(IJUST.EQ.'CJUS')IFONTH=1
40006      IF(IJUST.EQ.'RJUS')IFONTH=2
40007      IF(IJUST.EQ.'LEBO')IFONTH=0
40008      IF(IJUST.EQ.'CEBO')IFONTH=1
40009      IF(IJUST.EQ.'RIBO')IFONTH=2
40010      IF(IJUST.EQ.'LECE')IFONTH=0
40011      IF(IJUST.EQ.'CECE')IFONTH=1
40012      IF(IJUST.EQ.'RICE')IFONTH=2
40013      IF(IJUST.EQ.'LETO')IFONTH=0
40014      IF(IJUST.EQ.'CETO')IFONTH=1
40015      IF(IJUST.EQ.'RITO')IFONTH=2
40016      IF(IJUST.EQ.'LEFT')IFONTV=1
40017      IF(IJUST.EQ.'CENT')IFONTV=1
40018      IF(IJUST.EQ.'RIGH')IFONTV=1
40019      IF(IJUST.EQ.'LJUS')IFONTV=1
40020      IF(IJUST.EQ.'CJUS')IFONTV=1
40021      IF(IJUST.EQ.'RJUS')IFONTV=1
40022      IF(IJUST.EQ.'LEBO')IFONTV=1
40023      IF(IJUST.EQ.'CEBO')IFONTV=1
40024      IF(IJUST.EQ.'RIBO')IFONTV=1
40025      IF(IJUST.EQ.'LECE')IFONTV=0
40026      IF(IJUST.EQ.'CECE')IFONTV=0
40027      IF(IJUST.EQ.'RICE')IFONTV=0
40028      IF(IJUST.EQ.'LETO')IFONTV=2
40029      IF(IJUST.EQ.'CETO')IFONTV=2
40030      IF(IJUST.EQ.'RITO')IFONTV=2
40031      IERR=0
40032C
40033      CALL PLTXTV(IADE,STRING,DBLE(PX1),DBLE(PY1),IFONTH,IFONTV,
40034     1            DBLE(PHEIG2),IERR)
40035C
40036#endif
40037      GOTO9000
40038C
40039C               ******************************************************
40040C               **  STEP 31--                                       **
40041C               **  TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE     **
40042C               ******************************************************
40043C
40044 3100 CONTINUE
40045      IF(NCTEXT.LE.0)GOTO9000
40046C     JANUARY 1988: SOFTWARE SWITCH TO LET DATAPLOT DO THE JUSTIFICATION
40047C                   OR LET THE POST PROCESSOR DO IT
40048C
40049      PX1P=PX1
40050      PY1P=PY1
40051      ICSTR(1:8)='MOVE TO '
40052      NCSTR=8
40053      NCHTOT=10
40054      NCHDEC=5
40055      CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
40056      PX1P=AX
40057      PY1P=AY
40058      CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
40059      ICSTR(19:20)='  '
40060      NCSTR=20
40061      CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
40062      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40063      ICSTR(1:11)='WRITE TEXT '
40064      NCSTR=11
40065      DO3160I=1,NCTEXT
40066        ICTEMP=ICTEXT(I)
40067        NCSTR=NCSTR+1
40068        ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
40069 3160 CONTINUE
40070      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40071      GOTO9000
40072C
40073C               ***************************************************************
40074C               **  STEP 32--                                                **
40075C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
40076C               ***************************************************************
40077C
40078C  DECEMBER 1997.  MODIFY GENERAL CODED FOR THE GUI.
40079C
40080 3200 CONTINUE
40081      IF(NCTEXT.LE.0)GOTO9000
40082C     JANUARY 1988: SOFTWARE SWITCH TO LET DATAPLOT DO THE JUSTIFICATION
40083C                   OR LET THE POST PROCESSOR DO IT
40084C
40085      IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')THEN
40086        CALL GRTRSA(PX1,PY1,AX,AY,ISUBN0)
40087        IPXTMP=INT(AX*10.**IGENFA+0.5)
40088        IPYTMP=INT(AY*10.**IGENFA+0.5)
40089        ICSTR(1:2)='M '
40090        NCSTR=2
40091        NCHTOT=IGENFA+3
40092        CALL GRTRIN(IPXTMP,NCHTOT,ICSTR,NCSTR)
40093        NCSTR=NCSTR+1
40094        ICSTR(NCSTR:NCSTR)='  '
40095        CALL GRTRIN(IPYTMP,NCHTOT,ICSTR,NCSTR)
40096        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40097        ICSTR(1:5)='WRTE '
40098        NCSTR=5
40099        DO3285I=1,NCTEXT
40100          ICTEMP=ICTEXT(I)
40101          NCSTR=NCSTR+1
40102          ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
40103 3285   CONTINUE
40104        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40105      ELSE
40106        PX1P=PX1
40107        PY1P=PY1
40108        ICSTR(1:5)='MOTO '
40109        NCSTR=5
40110        NCHTOT=10
40111        NCHDEC=5
40112        CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
40113        PX1P=AX
40114        PY1P=AY
40115        CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
40116        ICSTR(16:17)='  '
40117        NCSTR=17
40118        CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
40119        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40120        ICSTR(1:5)='WRTE '
40121        NCSTR=5
40122        DO3260I=1,NCTEXT
40123          ICTEMP=ICTEXT(I)
40124          NCSTR=NCSTR+1
40125          ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
40126 3260   CONTINUE
40127        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40128      ENDIF
40129      GOTO9000
40130C
40131C               ******************************************************
40132C               **  STEP 33--                                       **
40133C               **  TREAT THE GENERAL (CGM               ) CASE     **
40134C               ******************************************************
40135C
40136 3300 CONTINUE
40137      IF(NCTEXT.LE.0)GOTO9000
40138C     SOFTWARE SWITCH TO LET DATAPLOT DO THE JUSTIFICATION
40139C     OR LET THE POST PROCESSOR DO IT
40140C
40141      ICSTR(1:15)='TEXTPATH DOWN;'
40142      NCSTR=15
40143      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40144C
40145      PX1P=PX1
40146      PY1P=PY1
40147      ICSTR(1:6)='TEXT ('
40148      NCSTR=6
40149      NCHTOT=10
40150      NCHDEC=5
40151      CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
40152      ICSTR(17:17)=','
40153      NCSTR=17
40154      CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
40155      ICSTR(28:34)=') FINAL'
40156      NCSTR=34
40157      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40158      ICSTR(1:1)='"'
40159      NCSTR=1
40160      K=0
40161      DO3362J=1,NCTEXT
40162        K=J+NCSTR
40163        ICSTR(K:K)=ICTEXT(J)
40164 3362 CONTINUE
40165      K=K+1
40166      ICSTR(K:K)='"'
40167      K=K+1
40168      ICSTR(K:K)=';'
40169      NCSTR=K
40170      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40171      GOTO9000
40172C
40173C               ***************************************************
40174C               **  STEP 34--                                    **
40175C               **  TREAT THE CGM (BINARY)                 CASE  **
40176C               ***************************************************
40177C
40178 3400 CONTINUE
40179      GOTO9000
40180C
40181C               ******************************************************
40182C               **  STEP 41--                                       **
40183C               **  TREAT THE CALCOMP XXXXXX CASE                   **
40184C               **  TO WRITE A VERTICAL TEXT STRING--               **
40185C               **  WRITE OUT AN XXXXXXXXXX                         **
40186C               **  USE CALCOMP LIBRARY ROUTINES                    **
40187C               **  REFERENCE--XX                                   **
40188C               **             XX                                   **
40189C               **             PAGES XX AND XX                      **
40190C               ******************************************************
40191C
40192 4100 CONTINUE
40193#ifdef HAVE_CALCOMP
40194      CALL CALCPT(PX1P,PY1P,AX1,AY1,ISUBN0)
40195      DO4112J=1,NCTEXT
40196        ICSTR(J:J)=ICTEXT(J)
40197 4112 CONTINUE
40198      ANGLE=90.
40199      AXTEMP=0.
40200      CALL CALCPT(AXTEMP,PHEIG2,AYTMP2,HEIGHT,ISUBN0)
40201      NCSTR=NCTEXT
40202      CALL CALCTR(ICSTR,IHOLL2,NCTEXT)
40203#endif
40204      GOTO9000
40205C
40206C               ******************************************************
40207C               **  STEP 46--                                       **
40208C               **  TREAT THE LAHEY   XXXXXX CASE                   **
40209C               **  REFERENCE--Programmer's Reference, Revision C   **
40210C               **             Lahey Computer Systems, January, 1992**
40211C               **             PAGES 51 THRU 65                     **
40212C               ******************************************************
40213C
40214 4600 CONTINUE
40215#ifdef HAVE_LAHEY_CALCOMP
40216      CLAHEY=0
40217      DO4601I=1,7
40218        RLAHEY(I)=0.0
402194601  CONTINUE
40220      DO4603I=1,9
40221        ILAHEY(I)=0.0
402224603  CONTINUE
40223      IF(NCTEXT.LE.0)GOTO9000
40224      CALL GRINFO(ILAHEY,RLAHEY,CLAHEY)
40225      PX1P=PX1
40226      PY1P=PY1
40227      CALL CALCPT(PX1P,PY1P,AX1,AY1,ISUBN0)
40228      ICOLMN=INT(REAL(ILAHEY(8))*(AX1*RLAHEY(1)/11.0)+0.5)
40229      ILINE=INT(REAL(ILAHEY(9))*(RLAHEY(1)*(8.5-AY1)/8.5)+0.5)
40230      IF(IJUSTH.EQ.'LEFT')THEN
40231        NSHIFT=0
40232      ELSEIF(IJUSTH.EQ.'CENT')THEN
40233        NSHIFT=1
40234      ELSEIF(IJUSTH.EQ.'RIGH')THEN
40235        NSHIFT=1
40236      ELSE
40237        NSHIFT=0
40238      ENDIF
40239      ICOLMN=ICOLMN-NSHIFT
40240      IF(ICOLMN.LT.1)ICOLMN=1
40241      IF(ICOLMN.GT.ILAHEY(8))ICOLMN=ILAHEY(8)
40242      IF(IJUSTV.EQ.'TOP ')THEN
40243        NSHIFT=0
40244      ELSEIF(IJUSTV.EQ.'CENT')THEN
40245        NSHIFT=NCTEXT/2
40246      ELSEIF(IJUSTV.EQ.'BOTT')THEN
40247        NSHIFT=NCTEXT
40248      ELSE
40249        NSHIFT=0
40250      ENDIF
40251      ILINE=ILINE-NSHIFT
40252      IF(ILINE.LT.1)ILINE=1
40253      IF(ILINE.GT.ILAHEY(9))ILINE=ILAHEY(9)
40254      DO4610I=1,NCTEXT
40255        ICTEMP=' '
40256        ICTEMP(1:1)=ICTEXT(I)
40257        IF(ILINE.GE.1.AND.ILINE.LE.ILAHEY(9))
40258     1     CALL GTEXT(ILINE,ICOLMN,ICTEMP)
40259        ILINE=ILINE+1
40260 4610 CONTINUE
40261#endif
40262      GOTO9000
40263C
40264C               ******************************************************
40265C               **  STEP 47--                                       **
40266C               **  TREAT THE MICROSOFT QUICKWIN DRIVER             **
40267C               **  FOR WINDOWS 95 AND WINDOWS NT.                  **
40268C               ******************************************************
40269C
40270 4700 CONTINUE
40271#ifdef HAVE_QWIN
40272      ICSTR=' '
40273      DO4712J=1,NCTEXT
40274        ICSTR(J:J)=ICTEXT(J)
40275 4712 CONTINUE
40276      CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
40277      CALL SETGTEXTROTATION(900)
40278      IWIDTH=GETGTEXTEXTENT(ICSTR(1:NCTEXT))
40279C
40280      IF(IJUST.EQ.'LEFT')GOTO4720
40281      IF(IJUST.EQ.'CENT')GOTO4750
40282      IF(IJUST.EQ.'RIGH')GOTO4780
40283C
40284      IF(IJUST.EQ.'LJUS')GOTO4720
40285      IF(IJUST.EQ.'CJUS')GOTO4750
40286      IF(IJUST.EQ.'RJUS')GOTO4780
40287C
40288      IF(IJUST.EQ.'LEBO')GOTO4710
40289      IF(IJUST.EQ.'CEBO')GOTO4720
40290      IF(IJUST.EQ.'RIBO')GOTO4730
40291C
40292      IF(IJUST.EQ.'LECE')GOTO4740
40293      IF(IJUST.EQ.'CECE')GOTO4750
40294      IF(IJUST.EQ.'RICE')GOTO4760
40295C
40296      IF(IJUST.EQ.'LETO')GOTO4770
40297      IF(IJUST.EQ.'CETO')GOTO4780
40298      IF(IJUST.EQ.'RITO')GOTO4790
40299C
40300      GOTO4710
40301C
40302 4710 CONTINUE
40303      IXINC=-IWIDTH
40304      IYINC=0
40305      GOTO4795
40306C
40307 4720 CONTINUE
40308      IXINC=-IWIDTH/2
40309      IYINC=0
40310      GOTO4795
40311C
40312 4730 CONTINUE
40313      IXINC=0
40314      IYINC=0
40315      GOTO4795
40316C
40317 4740 CONTINUE
40318      IXINC=-IWIDTH
40319      IYINC=JHEIG2/2
40320      GOTO4795
40321C
40322 4750 CONTINUE
40323      IXINC=-IWIDTH/2
40324      IYINC=JHEIG2/2
40325      GOTO4795
40326C
40327 4760 CONTINUE
40328      IXINC=0
40329      IYINC=JHEIG2/2
40330      GOTO4795
40331C
40332 4770 CONTINUE
40333      IXINC=-IWIDTH
40334      IYINC=JHEIG2
40335      GOTO4795
40336C
40337 4780 CONTINUE
40338      IXINC=-IWIDTH/2
40339      IYINC=JHEIG2
40340      GOTO4795
40341C
40342 4790 CONTINUE
40343      IXINC=0
40344      IYINC=JHEIG2
40345 4795 CONTINUE
40346C
40347      CALL MOVETO(INT2(IX1+IXINC),INT2(IY1+IYINC),XY)
40348      CALL OUTGTEXT(ICSTR(1:NCTEXT))
40349      CALL SETGTEXTROTATION(0)
40350#endif
40351      GOTO9000
40352C
40353C               ******************************************************
40354C               **  STEP 48--                                       **
40355C               **  TREAT THE OPEN-GL DRIVER                        **
40356C               **  FOR WINDOWS 95 AND WINDOWS NT AND X11           **
40357C               ******************************************************
40358C
40359 4800 CONTINUE
40360#ifdef HAVE_OPEN_GL
40361      IF(IOPGOF.EQ.'OFF')GOTO9000
40362C
40363      DO4805I=1,NCTEXT
40364        IC1=ICTEXT(I)(1:1)
40365        CALL DPCOAN(IC1,IJUNK)
40366        STRING(I)=IJUNK
40367 4805 CONTINUE
40368      STRING(NCTEXT+1)=0
40369C
40370      ILAST=80
40371      DO4810I=80,1,-1
40372        ILAST=I
40373        IF(IX11FN(I:I).NE.' ')GOTO4819
40374 4810 CONTINUE
40375 4819 CONTINUE
40376      DO4820I=1,ILAST
40377        CALL DPCOAN(IX11FN(I:I),IJUNK)
40378        IADE(I)=IJUNK
40379 4820 CONTINUE
40380      IADE(ILAST+1)=0
40381C
40382      CALL GLTATT(IADE,IXERR)
40383      IF(IXERR.EQ.1) THEN
40384        WRITE(ICOUT,4821)
40385 4821   FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE CURRENT FONT')
40386        CALL DPWRST('XXX','BUG ')
40387      ELSEIF(IXERR.EQ.2)THEN
40388        WRITE(ICOUT,4822)
40389 4822   FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE DEFAULT FONT')
40390        CALL DPWRST('XXX','BUG ')
40391      END IF
40392C
40393      IFONTH=0
40394      IFONTV=0
40395C
40396      IF(IJUST.EQ.'LEFT'.OR.IJUST.EQ.'LJUS')THEN
40397        IFONTH=1
40398        IFONTV=1
40399      ELSEIF(IJUST.EQ.'CENT'.OR.IJUST.EQ.'CJUS')THEN
40400        IFONTH=1
40401        IFONTV=0
40402      ELSEIF(IJUST.EQ.'RIGH'.OR.IJUST.EQ.'RJUS')THEN
40403        IFONTH=1
40404        IFONTV=2
40405      ELSEIF(IJUST.EQ.'LEBO')THEN
40406        IFONTH=0
40407        IFONTV=1
40408      ELSEIF(IJUST.EQ.'CEBO')THEN
40409        IFONTH=1
40410        IFONTV=1
40411      ELSEIF(IJUST.EQ.'RIBO')THEN
40412        IFONTH=2
40413        IFONTV=1
40414      ELSEIF(IJUST.EQ.'LECE')THEN
40415        IFONTH=0
40416        IFONTV=0
40417      ELSEIF(IJUST.EQ.'CECE')THEN
40418        IFONTH=1
40419        IFONTV=0
40420      ELSEIF(IJUST.EQ.'RICE')THEN
40421        IFONTH=2
40422        IFONTV=0
40423      ELSEIF(IJUST.EQ.'LETO')THEN
40424        IFONTH=0
40425        IFONTV=2
40426      ELSEIF(IJUST.EQ.'CETO')THEN
40427        IFONTH=1
40428        IFONTV=2
40429      ELSEIF(IJUST.EQ.'RITO')THEN
40430        IFONTH=2
40431        IFONTV=2
40432      ENDIF
40433C
40434      IXERR=0
40435      CALL GLTEXV(STRING,PX1,PY1,IFONTH,IFONTV,IXERR)
40436C
40437#endif
40438      GOTO9000
40439C
40440C               ******************************************************
40441C               **  STEP 49--                                       **
40442C               **  TREAT THE LAHEY INTERACTOR CASE                 **
40443C               ******************************************************
40444C
40445 4900 CONTINUE
40446      GOTO9000
40447C
40448C               ******************************************************
40449C               **  STEP 49B-                                       **
40450C               **  TREAT THE LAHEY WINTERACTOR CASE                **
40451C               ******************************************************
40452C
40453 4950 CONTINUE
40454#ifdef HAVE_WININTERACTER
40455      IF(NCTEXT.LE.0)GOTO9000
40456      CALL IGrCharJustify('C')
40457      NCSTR=0
40458      PY1P=PY1P+PHEIG2
40459      DO4910I=1,NCTEXT
40460        IF(I.GE.2)PY1P=PY1P-AFACT*(PHEIG2+PVEGA2)
40461        CALL IGrCharOut(PX1,PY1+PY1P,ICSTR(I:I))
40462 4910 CONTINUE
40463#endif
40464      GOTO9000
40465C
40466C
40467C               ******************************************************
40468C               **  STEP 51--                                       **
40469C               **  TREAT THE ZETA  3600SX AND 3653SX CASES         **
40470C               **  TO WRITE A VERTICAL TEXT STRING--               **
40471C               **  USE THE 1 OP CODE (= MOVE)                      **
40472C               **  ALONG WITH COORDINATES,                         **
40473C               **  USE THE 3 OP CODE (= CHARACTER STRING)          **
40474C               **  ALONG WITH RELATIVE COOR                        **
40475C               **  ALONG WITH NUMBER OF CHAR (= 1)                 **
40476C               **  ALONG WITH CONVERTED CHAR STRING                **
40477C               **  (2 CONVERTED CHAR FOR EVERY SINGLE CHAR).       **
40478C               **  REFERENCE--USER MANUAL FOR DIGITAL PLOTTER      **
40479C               **             MODELS 3600SX AND 3653SX             **
40480C               **             PAGES B-0 , B-1, AND E-1             **
40481C               **  REFERENCE--ZETA FORTRAN REFERENCE MANUAL        **
40482C               **             PAGE A-2                             **
40483C               **  NOTE--THE STRING IS "VERTICAL" ONLY IN SENSE    **
40484C               **        THAT THE STRING WILL STEP DOWN VERTICALLY **
40485C               **        BUT EACH CHARACTER WILL BE HORIZONTAL.    **
40486C               **        THIS CODE COULD BE IMPROVED TO TAKE       **
40487C               **        ADVANTAGE OF THE FACT THAT                **
40488C               **        THAT ZETA CAN ROTATE ITS CHARACTERS.      **
40489C               ******************************************************
40490C
40491 5100 CONTINUE
40492#ifdef HAVE_ZETA
40493      CALL CALCPT(PX1P,PY1P,AX1,AY1,ISUBN0)
40494      DO5112J=1,NCTEXT
40495        ICSTR(J:J)=ICTEXT(J)
40496 5112 CONTINUE
40497      ANGLE=90.
40498      AXTEMP=0.
40499      CALL CALCPT(AYTEMP,PHEIG2,AYTMP2,HEIGHT,ISUBN0)
40500      CALL CALCTR(ICSTR,IHOLL3,NCTEXT)
40501#endif
40502      GOTO9000
40503C
40504C               ******************************************************
40505C               **  STEP 66--                                       **
40506C               **  TREAT THE SUN CASE - WRITTEN BY BILL ANDERSON   **
40507C               ******************************************************
40508C
40509 6600 CONTINUE
40510#ifdef HAVE_SUN
40511      IF(NCTEXT.LE.0)GOTO9000
40512      DO6610I=1,NCTEXT
40513        NCSTR=1
40514        IF(I.GE.2)PY1P=PY1P-AFACT*(PHEIG2+PVEGA2)
40515        ICTEMP=ICTEXT(I)
40516        ICSTR(1:1)=ICTEMP(1:1)
40517        ITEMP=0
40518        CALL DPCONA(ITEMP,ICSTR(2:2))
40519        CALL GRTRSD(PX1P,PY1P,IX1P,IY1P,ISUBN0)
40520        CALL cftext(IX1P,IY1P,ICSTR(1:2))
40521 6610 CONTINUE
40522#endif
40523      GOTO9000
40524C
40525C               ******************************************************
40526C               **  STEP 81--                                       **
40527C               **  TREAT THE DEC  REGIS CASE                       **
40528C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
40529C               **  USE THE P[ (= POSITION ) INSTRUCTION            **
40530C               **  ALONG WITH INTEGER COORDINATES,                 **
40531C               **  WITH A TRAILING ]                               **
40532C               **  AND THE T' (= TEXT) INSTRUCTION                 **
40533C               **  AND THE DESIRED TEXT STRING,                    **
40534C               **  AND ' TO DENOTE THE END OF TEXT STRING,         **
40535C               **  REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE   **
40536C               **             PAGES 118 AND 120                    **
40537C               ******************************************************
40538C
40539C     MARCH, 1991.  PACK REGIS OUTPUT.  ALSO, REGIS DRAWS CHARACTER BELOW
40540C                   RATHER THAN ABOVE THE CURSUR POSITION (AS DATAPLOT
40541C                   ASSUMES), SO ADJUST STARTING POSITION BY A CHARACTER
40542C                   HEIGHT.
40543C
40544 8100 CONTINUE
40545C
40546      IF(NCTEXT.LE.0)GOTO9000
40547      NCSTR=0
40548      NCHTOT=5
40549      MAXREG=130
40550      PY1P=PY1P+PHEIG2
40551      DO8110I=1,NCTEXT
40552        IF(I.GE.2)PY1P=PY1P-AFACT*(PHEIG2+PVEGA2)
40553        IF(NCSTR.GT.MAXREG-18)THEN
40554          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40555          NCSTR=0
40556        END IF
40557        CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
40558        NCSTR=NCSTR+1
40559        NCSTR2=NCSTR+1
40560        ICSTR(NCSTR:NCSTR2)='P['
40561        NCSTR=NCSTR2
40562        CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
40563        NCSTR=NCSTR+1
40564        ICSTR(NCSTR:NCSTR)=','
40565        CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
40566        NCSTR=NCSTR+1
40567        ICSTR(NCSTR:NCSTR)=']'
40568C
40569        NCSTR=NCSTR+1
40570        ICSTR(NCSTR:NCSTR)='T'
40571        NCSTR=NCSTR+1
40572        ICSTR(NCSTR:NCSTR)=''''
40573        NCSTR=NCSTR+1
40574        ICTEMP=ICTEXT(I)
40575        ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
40576        NCSTR=NCSTR+1
40577        ICSTR(NCSTR:NCSTR)=''''
40578C
40579 8110 CONTINUE
40580      IF(NCSTR.GT.0)CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40581      GOTO9000
40582C
40583C               ******************************************************
40584C               **  STEP 86--                                       **
40585C               **  TREAT THE POSTSCRIPT            CASE            **
40586C               **  TO WRITE A VERTICAL   TEXT STRING--             **
40587C               **  90 ROTATE                                       **
40588C               **  XCOOR YCOOR MOVETO   (NOTE: USE UNADJUSTED COOR)**
40589C               **  (STRING) SHOW                                   **
40590C               **  -90 ROTATE                                      **
40591C               **  NOTE:  RIGHTSHOW AND CENTSHOW ARE DATAPLOT      **
40592C               **         DEFINED PROCEDURES TO RIGHT AND CENTER   **
40593C               **         JUSTIFY STRINGS RESPECTIVELY             **
40594C               **  REFERENCE--POSTSCRIPT TUTORIAL AND COOKBOOK     **
40595C               **             FROM ADOBE SYSTEMS                   **
40596C               **  FIRST SET FONT IF REQUIRED                      **
40597C               **  CHECK FOR "(", ")", AND BACKSLASH AND PRECEDE   **
40598C               **  WITH A                                          **
40599C               **  BACKSLASH                                       **
40600C               ******************************************************
40601C  OCTOBER  1991.  MAKE POSTSCRIPT FONTS TABLE DRIVEN
40602C  FEBRUARY 2009.  ADD SUPPORT FOR SUBSCRIPTS/SUPERSCRIPTS, GREEK
40603C                  CHARACTERS, AND MANY MATH/SPECIAL CHARACTERS.
40604C
40605 8600 CONTINUE
40606C
40607      IFLAGG=0
40608      CALL POSTTR(ICTEXT,NCTEXT,ICASE,MAXSYM,
40609     1            ISTARV,ISTOPV,IFONTP,SIZEV,OFFSEV,NSTRIN,NSPEC,
40610     1            IFLAGG,
40611     1            ISUBRO,IBUGG4)
40612C
40613      IF(NSPEC.LT.1)THEN
40614C
40615        IPSTPS=INT(JHEIG2+0.5)
40616        IF(IPSTFN.EQ.IPSTFC.AND.IPSTPC.EQ.IPSTPS)GOTO8605
40617        IJUNK=7
40618        DO8695I=1,IPSTMF
40619          IF(IPSTFN.NE.IPSTT1(I))GOTO8695
40620          IJUNK=I
40621          GOTO8697
40622 8695   CONTINUE
40623 8697   CONTINUE
40624        ICSTR(1:1)='/'
40625        ICSTR(2:41)=IPSTT2(IJUNK)(1:40)
40626        ICSTR(42:51)=' findfont '
40627        NCHTOT=5
40628        NCSTR=51
40629        CALL GRTRIN(IPSTPS,NCHTOT,ICSTR,NCSTR)
40630        NCSTR=NCSTR+1
40631        NCSTR2=NCSTR+17
40632        ICSTR(NCSTR:NCSTR2)=' scalefont setfont'
40633        NCSTR=NCSTR2
40634        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40635        IPSTFC=IPSTFN
40636        IPSTPC=IPSTPS
40637C
40638 8605   CONTINUE
40639        ICSTR(1:4)='/IX '
40640        NCSTR=4
40641        CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0)
40642        NCHTOT=5
40643        CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
40644        ICSTR(10:18)=' def /IY '
40645        NCSTR=18
40646        CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
40647        ICSTR(24:54)=' def newpath IX IY moveto gsave'
40648        NCSTR=54
40649        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40650C
40651        ICSTR(1:1)='('
40652        NCSTR=1
40653        DO8612J=1,NCTEXT
40654          IF(ICTEXT(J).NE.'('.AND.ICTEXT(J).NE.')'.AND.
40655     1       ICTEXT(J).NE.IBASLC)GOTO8613
40656          NCSTR=NCSTR+1
40657          ICSTR(NCSTR:NCSTR)=IBASLC
40658 8613     CONTINUE
40659          NCSTR=NCSTR+1
40660          ICSTR(NCSTR:NCSTR)=ICTEXT(J)
40661 8612   CONTINUE
40662        NCSTR=NCSTR+1
40663        ICSTR(NCSTR:NCSTR)=')'
40664        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40665        IF(IJUST(1:4).EQ.'BOTT')ICSTR(1:10)='vleftshow '
40666        IF(IJUST(1:4).EQ.'CENT')ICSTR(1:10)='vcentshow '
40667        IF(IJUST(1:4).EQ.'TOP ')ICSTR(1:10)='vrightshow'
40668        IF(IJUST(3:4).EQ.'BO')ICSTR(1:10)='vleftshow '
40669        IF(IJUST(3:4).EQ.'CE')ICSTR(1:10)='vcentshow '
40670        IF(IJUST(3:4).EQ.'TO')ICSTR(1:10)='vrightshow'
40671        IF(IJUST.EQ.'LEFT')ICSTR(1:10)='vleftshow '
40672        IF(IJUST.EQ.'LJUS')ICSTR(1:10)='vleftshow '
40673        IF(IJUST.EQ.'CENT')ICSTR(1:10)='vcentshow '
40674        IF(IJUST.EQ.'CJUS')ICSTR(1:10)='vcentshow '
40675        IF(IJUST.EQ.'RIGH')ICSTR(1:10)='vrightshow'
40676        IF(IJUST.EQ.'RJUS')ICSTR(1:10)='vrightshow'
40677        NCSTR=10
40678        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40679C
40680        ICSTR(1:8)='grestore'
40681        NCSTR=8
40682        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40683C
40684      ELSE
40685C
40686C       DEFINE THE INITIAL POSITION.
40687C
40688        NCSTR=8
40689        ICSTR(1:NCSTR)='newpath '
40690        CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
40691        NCHTOT=5
40692        CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
40693        NCSTR=14
40694        ICSTR(NCSTR:NCSTR)=' '
40695        CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
40696        ICSTR(20:26)=' moveto'
40697        NCSTR=26
40698        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40699C
40700C       CASE WHERE WE SPLIT THE STRING INTO A SERIES OF
40701C       SUBSTRINGS.
40702C
40703C       FOR BOTTOM JUSTIFIED STRING:
40704C           1) MOVE TO SPECIFIED START POSITION
40705C           2) LOOP THROUGH EACH SUBSTRING
40706C              A) SET FONT AND CHARACTER SIZE IF NEEDED
40707C              B) USE rmoveto TO DEFINE VERTICAL OFFSET
40708C                 (IF NEEDED)
40709C              C) USE vleftshow2 TO PRINT CURRENT SUBSTRING
40710C
40711C       FOR CENTER AND TOP JUSTIFIED STRINGS, WE NEED TO
40712C       MAKE AN INITIAL PASS THAT SUMS UP THE LENGTH OF THE
40713C       INDIVIDUAL STRINGS TO A SINGLE TOTAL LENGTH.  HOWEVER,
40714C       WE CAN THEN DEFINE THE INITIAL STARTING POINT AND THEN
40715C       JUST USE THE BOTTOM JUSTIFIED ALGORITHM.
40716C
40717        IJUSTV='BOTT'
40718        IF(IJUST(3:4).EQ.'BO')IJUSTV='BOTT'
40719        IF(IJUST(3:4).EQ.'CE')IJUSTV='CENT'
40720        IF(IJUST(3:4).EQ.'TO')IJUSTV='TOP '
40721        IF(IJUST.EQ.'LEFT')IJUSTV='BOTT'
40722        IF(IJUST.EQ.'LJUS')IJUSTV='BOTT'
40723        IF(IJUST.EQ.'CENT')IJUSTV='CENT'
40724        IF(IJUST.EQ.'CJUS')IJUSTV='CENT'
40725        IF(IJUST.EQ.'RIGH')IJUSTV='TOP '
40726        IF(IJUST.EQ.'RJUS')IJUSTV='TOP '
40727C
40728        IF(IJUSTV(1:1).EQ.'C' .OR. IJUSTV(1:1).EQ.'T')THEN
40729C         FOR CENTER AND TOP JUSTIFIED STRINGS, MAKE A PASS
40730C         TO DETERMINE THE LENGTH OF THE STRING.  FOR THIS CASE,
40731C         WE CAN IGNORE THE OFFSET.  HOWEVER, WE DO
40732C         NEED TO KEEP TRACK OF THE FONT AND SIZE OF EACH SUBSTRING.
40733C
40734          IPSTSV=INT(JHEIG2+0.5)
40735          IPSTCR=IPSTSV
40736          PY1PC=PY1P
40737          DO8820I=1,NSTRIN
40738            IF(ISTARV(I).GT.ISTOPV(I))GOTO8820
40739            ASIZE=SIZEV(I)
40740            IFONTT=IFONTP(I)
40741C
40742C           SET FONT AND FONT SIZE
40743C
40744            IF(ASIZE.LT.0.0)THEN
40745              IPSTCR=IPSTCR/2
40746            ELSEIF(ASIZE.GT.0.0)THEN
40747              IPSTCR=2*IPSTCR
40748            ELSE
40749              IPSTCR=IPSTSV
40750            ENDIF
40751            ICSTR(1:9)='/PSFONT /'
40752            IF(IFONTT.EQ.1)THEN
40753              ICSTR(10:15)='Symbol'
40754              ICSTR(16:49)=' '
40755            ELSE
40756              IJUNK=7
40757              DO8825II=1,IPSTMF
40758                IF(IPSTFN.NE.IPSTT1(II))GOTO8825
40759                IJUNK=II
40760                GOTO8827
40761 8825         CONTINUE
40762 8827         CONTINUE
40763              ICSTR(10:49)=IPSTT2(IJUNK)(1:40)
40764            ENDIF
40765            ICSTR(50:62)=' def /PSSIZE '
40766            NCHTOT=5
40767            NCSTR=62
40768            CALL GRTRIN(IPSTCR,NCHTOT,ICSTR,NCSTR)
40769            NCSTR=NCSTR+1
40770            NCSTR2=NCSTR+13
40771            ICSTR(NCSTR:NCSTR2)=' def setpsfont'
40772            NCSTR=NCSTR2
40773            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40774C
40775C           DETERMINE LENGTH OF CURRENT STRING AND ADD IT TO
40776C           THE TOTAL.
40777C
40778            ICSTR(1:1)='('
40779            NCSTR=1
40780            DO8832J=ISTARV(I),ISTOPV(I)
40781              IF(ICTEXT(J).NE.'('.AND.ICTEXT(J).NE.')'.AND.
40782     1          ICTEXT(J).NE.IBASLC)GOTO8833
40783              NCSTR=NCSTR+1
40784              ICSTR(NCSTR:NCSTR)=IBASLC
40785 8833         CONTINUE
40786              NCSTR=NCSTR+1
40787              ICSTR(NCSTR:NCSTR)=ICTEXT(J)
40788 8832       CONTINUE
40789C
40790            NCSTR=NCSTR+1
40791            ICSTR(NCSTR:NCSTR)=')'
40792            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40793            IF(IJUSTV(1:1).EQ.'C')THEN
40794              NCSTR=15
40795              ICSTR(1:NCSTR)='psstringwidthcv'
40796              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40797            ELSEIF(IJUSTV(1:1).EQ.'T')THEN
40798              NCSTR=15
40799              ICSTR(1:NCSTR)='psstringwidthtv'
40800              CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40801            ENDIF
40802C
40803 8820     CONTINUE
40804C
40805        ENDIF
40806C
40807C       NOW DRAW EACH OF THE SUBSTRINGS
40808C
40809        IPSTSV=INT(JHEIG2+0.5)
40810        IPSTCR=IPSTSV
40811        PY1PC=PY1P
40812        DO8720I=1,NSTRIN
40813          IF(ISTARV(I).GT.ISTOPV(I))GOTO8720
40814          ASIZE=SIZEV(I)
40815          AOFFS=OFFSEV(I)
40816          IFONTT=IFONTP(I)
40817C
40818C         STEP 2A: SET FONT AND FONT SIZE
40819C
40820          IF(ASIZE.LT.0.0)THEN
40821            IPSTCR=IPSTCR/2
40822          ELSEIF(ASIZE.GT.0.0)THEN
40823            IPSTCR=2*IPSTCR
40824          ELSE
40825            IPSTCR=IPSTSV
40826          ENDIF
40827          ICSTR(1:9)='/PSFONT /'
40828          IF(IFONTT.EQ.1)THEN
40829            ICSTR(10:15)='Symbol'
40830            ICSTR(16:49)=' '
40831          ELSE
40832            IJUNK=7
40833            DO8725II=1,IPSTMF
40834              IF(IPSTFN.NE.IPSTT1(II))GOTO8725
40835              IJUNK=II
40836              GOTO8727
40837 8725       CONTINUE
40838 8727       CONTINUE
40839            ICSTR(10:49)=IPSTT2(IJUNK)(1:40)
40840          ENDIF
40841          ICSTR(50:62)=' def /PSSIZE '
40842          NCHTOT=5
40843          NCSTR=62
40844          CALL GRTRIN(IPSTCR,NCHTOT,ICSTR,NCSTR)
40845          NCSTR=NCSTR+1
40846          NCSTR2=NCSTR+13
40847          ICSTR(NCSTR:NCSTR2)=' def setpsfont'
40848          NCSTR=NCSTR2
40849          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40850C
40851C         STEP 2B: SET RELATIVE VERTICAL OFFSET IF NEEDED
40852C
40853          IF(AOFFS.GT.0.0)THEN
40854            PYTEMP=0.0
40855            POFFST=PYLEC/2.0
40856            CALL GRTRSD(POFFST,PYTEMP,IX,IY,ISUBN0)
40857            IX=-IX
40858            NCHTOT=5
40859            NCSTR=0
40860            CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
40861            NCSTR=NCSTR+1
40862            ICSTR(NCSTR:NCSTR)=' '
40863            CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
40864            NCSTR=NCSTR+1
40865            NCSTR2=NCSTR+7
40866            ICSTR(NCSTR:NCSTR2)=' rmoveto'
40867            NCSTR=NCSTR2
40868            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40869          ELSEIF(AOFFS.LT.0.0)THEN
40870            PYTEMP=0.0
40871            POFFST=PYLEC/2.0
40872            CALL GRTRSD(POFFST,PYTEMP,IX,IY,ISUBN0)
40873            NCHTOT=5
40874            NCSTR=0
40875            CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
40876            NCSTR=NCSTR+1
40877            ICSTR(NCSTR:NCSTR)=' '
40878            CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
40879            NCSTR=NCSTR+1
40880            NCSTR2=NCSTR+7
40881            ICSTR(NCSTR:NCSTR2)=' rmoveto'
40882            NCSTR=NCSTR2
40883            CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40884          ENDIF
40885C
40886C         STEP 2C: PRINT CURRENT SUBSTRING
40887C
40888          ICSTR(1:1)='('
40889          NCSTR=1
40890          DO8732J=ISTARV(I),ISTOPV(I)
40891            IF(ICTEXT(J).NE.'('.AND.ICTEXT(J).NE.')'.AND.
40892     1        ICTEXT(J).NE.IBASLC)GOTO8733
40893            NCSTR=NCSTR+1
40894            ICSTR(NCSTR:NCSTR)=IBASLC
40895 8733       CONTINUE
40896            NCSTR=NCSTR+1
40897            ICSTR(NCSTR:NCSTR)=ICTEXT(J)
40898 8732     CONTINUE
40899C
40900          NCSTR=NCSTR+1
40901          ICSTR(NCSTR:NCSTR)=')'
40902          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40903          NCSTR=11
40904          ICSTR(1:NCSTR)='vleftshow2 '
40905          CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40906C
40907 8720   CONTINUE
40908C
40909C       RESET DEFAULT FONT AND POINT SIZE
40910C
40911        ICSTR(1:9)='/PSFONT /'
40912        IJUNK=7
40913        DO8925II=1,IPSTMF
40914          IF(IPSTFN.NE.IPSTT1(II))GOTO8925
40915          IJUNK=II
40916          GOTO8927
40917 8925   CONTINUE
40918 8927   CONTINUE
40919        ICSTR(10:49)=IPSTT2(IJUNK)(1:40)
40920        ICSTR(50:62)=' def /PSSIZE '
40921        NCHTOT=5
40922        NCSTR=62
40923        CALL GRTRIN(IPSTCR,NCHTOT,ICSTR,NCSTR)
40924        NCSTR=NCSTR+1
40925        NCSTR2=NCSTR+13
40926        ICSTR(NCSTR:NCSTR2)=' def setpsfont'
40927        NCSTR=NCSTR2
40928        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40929C
40930      ENDIF
40931C
40932      GOTO9000
40933C
40934C               ******************************************************
40935C               **  STEP 91--                                       **
40936C               **  TREAT THE QUIC                  CASE            **
40937C               **  TO WRITE A HORIZONTAL TEXT STRING--             **
40938C               **  MOVE: ^IHXXXXX^IVXXXXX                          **
40939C               **  SET DEFAULT FONT:^ISXXXXX                       **
40940C               **  SET FONT FOR CURRENT LINE: ^SMXXXXX             **
40941C               **  ENTER TEXT                                      **
40942C               **  REFERENCE--QUIC PROGRAMMING MANUAL FOR QMS      **
40943C               **             CHAPTER 7 DISCUSSES FONTS            **
40944C               ******************************************************
40945C
40946 9100 CONTINUE
40947C
40948      IF(NCTEXT.LE.0)GOTO9000
40949      IFONTT=IQUIFN
40950      IF(IORNSW.EQ.'PORT'.AND.(
40951     1   IFONTT.EQ.521 .OR. IFONTT.EQ.522 .OR.
40952     1   IFONTT.EQ.523 .OR. IFONTT.EQ.524))IFONTT=10
40953      IF(IORNSW.NE.'PORT'.AND.(
40954     1   IFONTT.EQ.124 .OR. IFONTT.EQ.144 .OR.
40955     1   IFONTT.EQ.16  .OR. IFONTT.EQ.328 .OR.
40956     1   IFONTT.EQ.998 .OR. IFONTT.EQ.404 .OR.
40957     1   IFONTT.EQ.444 .OR. IFONTT.EQ.532))IFONTT=10
40958      CALL DPCONA(94,ICARAT)
40959      IF(IFONTT.EQ.IQUIFC)GOTO9105
40960      ICSTR(1:1)=ICARAT
40961      ICSTR(2:3)='IS'
40962      IQUIFC=IFONTT
40963      KFONT=IFONTT
40964      NCHTOT=-5
40965      NCSTR=3
40966      CALL GRTRIN(KFONT,NCHTOT,ICSTR,NCSTR)
40967      NCSTR=9
40968      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40969C
40970 9105 CONTINUE
40971      NCHTOT=-5
40972      DO9110I=1,NCTEXT
40973        IF(I.GE.2)PY1P=PY1P-AFACT*(PHEIG2+PVEGA2)
40974        PYTEMP=100.-PY1P
40975        CALL QUICPT(PX1P,PYTEMP,IX,IY,ISUBN0)
40976        ICSTR(1:1)=ICARAT
40977        ICSTR(2:3)='IH'
40978        NCSTR=3
40979        CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
40980        ICSTR(9:9)=ICARAT
40981        ICSTR(10:11)='IV'
40982        NCSTR=11
40983        CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
40984        NCSTR=17
40985        ICTEMP=ICTEXT(I)
40986        ICSTR(NCSTR:NCSTR)=ICTEMP(1:1)
40987        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
40988 9110 CONTINUE
40989      GOTO9000
40990C
40991C               ******************************************************
40992C               **  STEP 96--                                       **
40993C               **  TREAT THE X11        CASE                       **
40994C               **  NOTE THAT JUSTIFICATION, POSITIONING, ETC. IS   **
40995C               **  HANDLED BY THE C ROUTINE.  ALSO, THE CHARACTER  **
40996C               **  STRING IS PASSED TO C AS AN INTEGER ARRAY       **
40997C               **  CONTAINING THE ASCII DECIMAL EQUIVALENTS        **
40998C               ******************************************************
40999C
41000 9600 CONTINUE
41001#ifdef HAVE_X11
41002      IF(IX11OF.EQ.'OFF')GOTO9000
41003C
41004      CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
41005C
41006      DO9605I=1,NCTEXT
41007        IC1=ICTEXT(I)(1:1)
41008        CALL DPCOAN(IC1,IJUNK)
41009        STRING(I)=IJUNK
41010 9605 CONTINUE
41011      STRING(NCTEXT+1)=0
41012C
41013      ILAST=80
41014      DO9610I=80,1,-1
41015        ILAST=I
41016        IF(IX11FN(I:I).NE.' ')GOTO9619
41017 9610 CONTINUE
41018 9619 CONTINUE
41019      DO9620I=1,ILAST
41020        CALL DPCOAN(IX11FN(I:I),IJUNK)
41021        IADE(I)=IJUNK
41022 9620 CONTINUE
41023      IADE(ILAST+1)=0
41024C
41025      CALL XTATTR(IADE,IXERR)
41026      IF(IXERR.EQ.1) THEN
41027        WRITE(ICOUT,9621)
41028 9621   FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE CURRENT FONT')
41029        CALL DPWRST('XXX','BUG ')
41030      ELSEIF(IXERR.EQ.2)THEN
41031        WRITE(ICOUT,9622)
41032 9622   FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE DEFAULT FONT')
41033        CALL DPWRST('XXX','BUG ')
41034      END IF
41035C
41036      IFONTH=0
41037      IFONTV=0
41038C
41039      IF(IJUST.EQ.'LEFT'.OR.IJUST.EQ.'LJUS')THEN
41040        IFONTH=1
41041        IFONTV=1
41042      ELSEIF(IJUST.EQ.'CENT'.OR.IJUST.EQ.'CJUS')THEN
41043        IFONTH=1
41044        IFONTV=0
41045      ELSEIF(IJUST.EQ.'RIGH'.OR.IJUST.EQ.'RJUS')THEN
41046        IFONTH=1
41047        IFONTV=2
41048      ELSEIF(IJUST.EQ.'LEBO')THEN
41049        IFONTH=0
41050        IFONTV=1
41051      ELSEIF(IJUST.EQ.'CEBO')THEN
41052        IFONTH=1
41053        IFONTV=1
41054      ELSEIF(IJUST.EQ.'RIBO')THEN
41055        IFONTH=2
41056        IFONTV=1
41057      ELSEIF(IJUST.EQ.'LECE')THEN
41058        IFONTH=0
41059        IFONTV=0
41060      ELSEIF(IJUST.EQ.'CECE')THEN
41061        IFONTH=1
41062        IFONTV=0
41063      ELSEIF(IJUST.EQ.'RICE')THEN
41064        IFONTH=2
41065        IFONTV=0
41066      ELSEIF(IJUST.EQ.'LETO')THEN
41067        IFONTH=0
41068        IFONTV=2
41069      ELSEIF(IJUST.EQ.'CETO')THEN
41070        IFONTH=1
41071        IFONTV=2
41072      ELSEIF(IJUST.EQ.'RITO')THEN
41073        IFONTH=2
41074        IFONTV=2
41075      ENDIF
41076C
41077      IXERR=0
41078      CALL XTEXTV(STRING,IX,IY,IFONTH,IFONTV,IXERR)
41079C
41080#endif
41081      GOTO9000
41082C
41083CCCCC THE FOLLOWING SECTION WAS ADDED   MAY 1991  (JJF)
41084CCCCC AND REFIXED                       SEPTEMBER 1995
41085C               *************************************************
41086C               **  STEP 100--                                 **
41087C               **  TREAT THE VGA VIA TURBO-C       CASE       **
41088C               **  REFERENCE--TURBO C 1.5 ADDITIONS &         **
41089C               **             ENHANCEMENTS, PAGE 124, 113.    **
41090C               **  REFERENCE--TURBO C 2.0 REFERENCE GUIDE,    **
41091C               **             PAGE 324-325, 256.              **
41092C               **  REFERENCE--WEISKAMP, POWER GRAPHICS        **
41093C               **             USING TURBO C, PAGE 59-60, 54-55**
41094C               *************************************************
41095C
4109610000 CONTINUE
41097      IF(ITCST.EQ.'CLOS')GOTO9000
41098      IF(NCTEXT.LE.0)GOTO9000
41099C
41100CCCCC THE FOLLOWING 2 LINES OF CODE WERE REPLACED  SEPTEMBER 1994
41101CCCCC BY THE REST OF THIS SECTION                  SEPTEMBER 1994
41102CCCCC TO FIX C-SIDE MULTIPLOTTING NOT WORKING      SEPTEMBER 1994
41103C
41104CCCCC CALL TCMOTO(PX1,PY1)
41105CCCCC CALL TCWRTE(ICTEXT,NCTEXT)
41106C
41107CCCCC THE FOLLOWING LINE WAS COMMENTED OUT AND    JANUARY 1995
41108CCCCC THE FOLLOWING SECTION WAS COMMENTED OUT     JANUARY 1995
41109CCCCC TO FIX THE Y1LABEL PROBLEM                  JANUARY 1995
41110CCCCC IF(IJUSSW.NE.'ON')THEN
41111CCCCC IF(1.EQ.1)THEN
41112CCCCC    DO10010I=1,NCTEXT
41113CCCCC       IF(I.GE.2)PY1P=PY1P-(PHEIG2+PVEGA2)
41114CCCCC       CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
41115CCCCC       PX1P=AX
41116CCCCC       PY1P=AY
41117CCCCC       CALL TCMOTO(PX1P,PY1P)
41118CCCCC       CALL TCWRTE(ICTEXT(I),6)
41119C10010    CONTINUE
41120CCCCC ENDIF
41121C
41122CCCCC THE FOLLOWING SECTION WAS CHANGED     JANUARY 1995
41123CCCCC TO FIX THE Y1LABEL PROBLEM            JANUARY 1995
41124      PX1P=PX1
41125      PY1P=PY1
41126      CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
41127      PX1P=AX
41128      PY1P=AY
41129CTURB CALL TCMOTO(PX1P,PY1P)
41130CTURB CALL TCWRTE(ICTEXT,NCTEXT)
41131C
41132CCCCC NCSTR=0
41133CCCCC DO10020I=1,NCTEXT
41134CCCCC    NCSTR=NCSTR+1
41135CCCCC    ICTEMP=ICTEXT(I)
41136CCCCC    ICSTR(I:I)=ICTEMP(1:1)
41137C10020 CONTINUE
41138CCCCC CALL TCWRTE(ICSTR,NCSTR)
41139      GOTO9000
41140C
41141C               ******************************************************
41142C               **  STEP 110--                                      **
41143C               **  TREAT THE GKS                DRIVER             **
41144C               ******************************************************
41145C
4114611000 CONTINUE
41147      GOTO9000
41148C
41149C               ******************************************************
41150C               **  STEP 120--                                      **
41151C               **  TREAT THE GD                     DRIVER         **
41152C               **  THIS LIBRARY PROVIDES SUPPORT FOR:              **
41153C               **  1) JPEG                                         **
41154C               **  2) PNG                                          **
41155C               **  3) WINDOWS BMP (BLACK/WHITE ONLY)               **
41156C               **  TREAT THE PBM (PORTABLE BIT MAP) DRIVER         **
41157C               ******************************************************
41158C
4115912000 CONTINUE
41160C
41161      CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
41162C
41163      IFONTZ=0
41164      IF(IGDFN(1:5).EQ.'SMALL')IFONTZ=1
41165      IF(IGDFN(1:5).EQ.'LARGE')IFONTZ=2
41166      IF(IGDFN(1:10).EQ.'MEDIUMBOLD')IFONTZ=3
41167      IF(IGDFN(1:5).EQ.'GIANT')IFONTZ=4
41168      IF(IGDFN(1:4).EQ.'TINY')IFONTZ=5
41169C
41170      DO12605I=1,NCTEXT
41171        IC1=ICTEXT(I)(1:1)
41172        CALL DPCOAN(IC1,IJUNK)
41173        STRING(I)=IJUNK
4117412605 CONTINUE
41175      STRING(NCTEXT+1)=0
41176C
41177      ILAST=80
41178      DO12610I=80,1,-1
41179        ILAST=I
41180        IF(IGDFN(I:I).NE.' ')GOTO12619
4118112610 CONTINUE
4118212619 CONTINUE
41183      DO12620I=1,ILAST
41184        CALL DPCOAN(IGDFN(I:I),IJUNK)
41185        IADE(I)=IJUNK
4118612620 CONTINUE
41187      IADE(ILAST+1)=0
41188C
41189      IFONTH=0
41190      IFONTV=0
41191      IF(IJUST.EQ.'LEFT')IFONTH=0
41192      IF(IJUST.EQ.'CENT')IFONTH=1
41193      IF(IJUST.EQ.'RIGH')IFONTH=2
41194      IF(IJUST.EQ.'LJUS')IFONTH=0
41195      IF(IJUST.EQ.'CJUS')IFONTH=1
41196      IF(IJUST.EQ.'RJUS')IFONTH=2
41197      IF(IJUST.EQ.'LEBO')IFONTH=0
41198      IF(IJUST.EQ.'CEBO')IFONTH=1
41199      IF(IJUST.EQ.'RIBO')IFONTH=2
41200      IF(IJUST.EQ.'LECE')IFONTH=0
41201      IF(IJUST.EQ.'CECE')IFONTH=1
41202      IF(IJUST.EQ.'RICE')IFONTH=2
41203      IF(IJUST.EQ.'LETO')IFONTH=0
41204      IF(IJUST.EQ.'CETO')IFONTH=1
41205      IF(IJUST.EQ.'RITO')IFONTH=2
41206      IF(IJUST.EQ.'LEFT')IFONTV=1
41207      IF(IJUST.EQ.'CENT')IFONTV=1
41208      IF(IJUST.EQ.'RIGH')IFONTV=1
41209      IF(IJUST.EQ.'LJUS')IFONTV=1
41210      IF(IJUST.EQ.'CJUS')IFONTV=1
41211      IF(IJUST.EQ.'RJUS')IFONTV=1
41212      IF(IJUST.EQ.'LEBO')IFONTV=1
41213      IF(IJUST.EQ.'CEBO')IFONTV=1
41214      IF(IJUST.EQ.'RIBO')IFONTV=1
41215      IF(IJUST.EQ.'LECE')IFONTV=0
41216      IF(IJUST.EQ.'CECE')IFONTV=0
41217      IF(IJUST.EQ.'RICE')IFONTV=0
41218      IF(IJUST.EQ.'LETO')IFONTV=2
41219      IF(IJUST.EQ.'CETO')IFONTV=2
41220      IF(IJUST.EQ.'RITO')IFONTV=2
41221      IERR=0
41222C
41223#ifdef HAVE_GD
41224      CALL GDTXTV(IADE,STRING,IFONTZ,IX,IY,IFONTH,IFONTV,
41225     1            JCOL,JHEIG2,IERR)
41226C
41227#endif
41228      GOTO9000
41229C
41230C               ******************************************************
41231C               **  STEP 130--                                      **
41232C               **  TREAT THE MACINTOSH              DRIVER         **
41233C               **  LIBRARY FROM ABSOFT COMPILER                    **
41234C               ******************************************************
41235C
4123613000 CONTINUE
41237      GOTO9000
41238C
41239C               ******************************************************
41240C               **  STEP 135--                                      **
41241C               **  TREAT THE MAC OSX AQUATERM       DRIVER         **
41242C               ******************************************************
41243C
4124413500 CONTINUE
41245C
41246      CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
41247C
41248      DO13505I=1,NCTEXT
41249        IC1=ICTEXT(I)(1:1)
41250        CALL DPCOAN(IC1,IJUNK)
41251        STRING(I)=IJUNK
4125213505 CONTINUE
41253      STRING(NCTEXT+1)=0
41254C
41255      ILAST=80
41256      DO13510I=80,1,-1
41257        ILAST=I
41258        IF(IAQUFN(I:I).NE.' ')GOTO13519
4125913510 CONTINUE
4126013519 CONTINUE
41261      DO13520I=1,ILAST
41262        CALL DPCOAN(IAQUFN(I:I),IJUNK)
41263        IADE(I)=IJUNK
4126413520 CONTINUE
41265      IADE(ILAST+1)=0
41266C
41267COLD  aqtAddLabel(ICTEXT(1:NCTEXT),PX1,PY1,AROT,IAQJUS)
41268      IF(IJUSTH.EQ.'LEFT')IFONTH=0
41269      IF(IJUSTH.EQ.'CENT')IFONTH=1
41270      IF(IJUSTH.EQ.'RIGH')IFONTH=2
41271      IF(IJUSTV.EQ.'BOTT')IFONTV=0
41272      IF(IJUSTV.EQ.'MIDD')IFONTV=1
41273      IF(IJUSTV.EQ.'TOP ')IFONTV=2
41274#ifdef HAVE_AQUA
41275      CALL aqtxtv(STRING,IX,IY,IFONTH,IFONTV,IADE,IERR)
41276#endif
41277      GOTO9000
41278C
41279C
41280C               ******************************************************
41281C               **  STEP 150--                                      **
41282C               **  TREAT THE LATEX (USING EEPIC)    DRIVER         **
41283C               ******************************************************
41284C
4128515000 CONTINUE
41286C
41287CCCCC NOTE: ALTHOUGH THE ROTATEBOX APPROACH IS DESIRED (SO
41288CCCCC       VERTICAL TEXT WILL BE ROTATED), THIS DOES NOT
41289CCCCC       SEEM TO WORK WITH MBOX (I NEED MBOX IN ORDER TO
41290CCCCC       GENERATE THE APPROPRIATE JUSTIFICATION).  SO
41291CCCCC       FOR NOW, USE THE SHORTSTACK APPROACH INSTEAD
41292CCCCC       (THIS PLOTS THE VERTICAL STRING AS A COLUMN OF
41293CCCCC       HORIZONTAL CHARACTERS).
41294C
41295      NCSTR=0
41296      CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
41297      NCSTR=NCSTR+1
41298      ICSTR(NCSTR:NCSTR)=IBASLC
41299      NCSTR=NCSTR+1
41300      ICSTR(NCSTR:NCSTR+3)='put('
41301      NCSTR=NCSTR+3
41302      NCHTOT=5
41303      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
41304      NCSTR=NCSTR+1
41305      ICSTR(NCSTR:NCSTR)=','
41306      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
41307      NCSTR=NCSTR+1
41308      ICSTR(NCSTR:NCSTR+15)='){ makebox(0,0)['
41309      ICSTR(NCSTR+2:NCSTR+2)=IBASLC
41310      NCSTR=NCSTR+15
41311C
41312      IF(IJUSTV.EQ.'CENT')THEN
41313        NCSTR=NCSTR+1
41314        ICSTR(NCSTR:NCSTR)='c'
41315      ELSEIF(IJUSTV.EQ.'BOTT')THEN
41316        NCSTR=NCSTR+1
41317        ICSTR(NCSTR:NCSTR)='b'
41318      ELSEIF(IJUSTV.EQ.'TOP ')THEN
41319        NCSTR=NCSTR+1
41320        ICSTR(NCSTR:NCSTR)='t'
41321      ENDIF
41322C
41323      IF(IJUSTH.EQ.'CENT')THEN
41324        NCSTR=NCSTR+1
41325        ICSTR(NCSTR:NCSTR)='c'
41326      ELSEIF(IJUSTH.EQ.'LEFT')THEN
41327        NCSTR=NCSTR+1
41328        ICSTR(NCSTR:NCSTR)='l'
41329      ELSEIF(IJUSTH.EQ.'RIGH')THEN
41330        NCSTR=NCSTR+1
41331        ICSTR(NCSTR:NCSTR)='r'
41332      ENDIF
41333      NCSTR=NCSTR+1
41334      ICSTR(NCSTR:NCSTR)=']'
41335C
41336      DO15110J=1,NCTEXT
41337        ICSTR2(J:J)=ICTEXT(J)(1:1)
4133815110 CONTINUE
41339      MAXWID=130
41340      CALL LATCON(ICSTR2,NCTEXT,ICSTR3,NCTEX2,MAXWID,ISUBRO,IERROR)
41341C
41342      NCSTR=NCSTR+1
41343      ICSTR(NCSTR:NCSTR)='{'
41344      NCSTR=NCSTR+1
41345      ICSTR(NCSTR:NCSTR)=IBASLC
41346      NCSTR=NCSTR+1
41347      ICSTR(NCSTR:NCSTR+13)='rotatebox{90}{'
41348      NCSTR=NCSTR+13
41349      ICNT=NCSTR
41350      DO15102J=1,NCTEX2
41351        ICNT=ICNT+1
41352        ICSTR(ICNT:ICNT)=ICSTR3(J:J)
4135315102 CONTINUE
41354      NCSTR=ICNT
41355      NCSTR=NCSTR+1
41356      ICSTR(NCSTR:NCSTR+2)='}}}'
41357      NCSTR=NCSTR+2
41358C
41359      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
41360C
41361      GOTO9000
41362C
41363C               ******************************************************
41364C               **  STEP 160--                                      **
41365C               **  TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER **
41366C               ******************************************************
41367C
4136816000 CONTINUE
41369C
41370C     JULY 2015.  FOR THE CHROME BROWSER, NEED TO HAVE
41371C
41372C                   X="95" Y="233"
41373C
41374C                 RATHER THAN
41375C
41376C                   X="   95" Y="   233"
41377C
41378      CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0)
41379C
41380      IF(IJUSTV.EQ.'TOP')THEN
41381        IX=IX+JHEIG2
41382      ELSEIF(IJUSTV.EQ.'CENT')THEN
41383        IY=IY+(JHEIG2/2)
41384      ELSE
41385        CONTINUE
41386      ENDIF
41387C
41388      CALL DPCONA(34,IQUOTE)
41389C
41390      ISVGLN=ISVGLN+1
41391      ICSTR(1:9)='   <g id='
41392      ICSTR(10:10)=IQUOTE
41393      NCSTR=10
41394      IF(ISVGLN.LE.9)THEN
41395        NCHTOT=1
41396      ELSEIF(ISVGLN.LE.99)THEN
41397        NCHTOT=2
41398      ELSEIF(ISVGLN.LE.999)THEN
41399        NCHTOT=3
41400      ELSEIF(ISVGLN.LE.9999)THEN
41401        NCHTOT=4
41402      ELSEIF(ISVGLN.LE.99999)THEN
41403        NCHTOT=5
41404      ELSE
41405        NCHTOT=6
41406      ENDIF
41407      CALL GRTRIN(ISVGLN,NCHTOT,ICSTR,NCSTR)
41408      NCSTR=NCSTR+1
41409      ICSTR(NCSTR:NCSTR)=IQUOTE
41410      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
41411C
41412      NCSTR=19
41413      NCSTR=NCSTR+1
41414      ICSTR(1:19)='         transform='
41415      ICSTR(NCSTR:NCSTR)=IQUOTE
41416      NCSTR=NCSTR+1
41417      ICSTR(NCSTR:NCSTR+10)='rotate(-90,'
41418      NCSTR=NCSTR+10
41419      NCHTOT=5
41420      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
41421      NCSTR=NCSTR+1
41422      ICSTR(NCSTR:NCSTR)=','
41423      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
41424      NCSTR=NCSTR+1
41425      ICSTR(NCSTR:NCSTR)=')'
41426      NCSTR=NCSTR+1
41427      ICSTR(NCSTR:NCSTR)=IQUOTE
41428      NCSTR=-NCSTR
41429      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
41430C
41431      IF(ISVGSS(1:3).EQ.'EXT')THEN
41432        NCSTR=22
41433        ICSTR(1:NCSTR)='      class="vertical"'
41434        NCSTR=-NCSTR
41435        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
41436C
41437        CALL GRTRCO('FORE',ISVGFC,JCOL2)
41438        ICSTR(1:12)='      style='
41439        ICSTR(13:13)=IQUOTE
41440        NCSTR=-13
41441        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
41442        NCSTR=19
41443        ICSTR(1:NCSTR)='             fill:#'
41444        NCHTOT=2
41445        JTEMP=JCOL
41446        IF(JTEMP.LE.0)THEN
41447C
41448C         DATAPLOT CURRENTLY ALLOWS GREYSCALE VALUES IN
41449C         THE RANGE 0 TO 100.  FOR SPECIFYING COLOR TO SVG,
41450C         SCALE THAT 0 TO 100 VALUE TO A 0 TO 255 VALUE.
41451C
41452          AVAL=(255./100.)*REAL(ABS(JTEMP))
41453          IF(AVAL.LE.0.0)AVAL=0.0
41454          IF(AVAL.GE.255.0)AVAL=255.0
41455          JRED=INT(AVAL+0.5)
41456          JBLUE=JRED
41457          JGREEN=JRED
41458        ELSE
41459          IF(JTEMP.LT.1 .OR. JTEMP.GT.MAXCLR)JTEMP=1
41460          JRED=IRED(JTEMP)
41461          JGREEN=IGREEN(JTEMP)
41462          JBLUE=IBLUE(JTEMP)
41463        ENDIF
41464        CALL DPCONX(JRED,ICJUNK)
41465        NCSTR=NCSTR+1
41466        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
41467        NCSTR=NCSTR+1
41468        CALL DPCONX(JGREEN,ICJUNK)
41469        NCSTR=NCSTR+1
41470        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
41471        NCSTR=NCSTR+1
41472        CALL DPCONX(JBLUE,ICJUNK)
41473        NCSTR=NCSTR+1
41474        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
41475        NCSTR=NCSTR+2
41476        ICSTR(NCSTR:NCSTR)=';'
41477        NCSTR=-NCSTR
41478        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
41479        NCSTR=22
41480        ICSTR(1:NCSTR)='            font-size:'
41481        NCHTOT=3
41482        CALL GRTRIN(JHEIG2,NCHTOT,ICSTR,NCSTR)
41483        NCSTR=NCSTR+1
41484        ICSTR(NCSTR:NCSTR+2)='pt;'
41485        NCSTR=NCSTR+2
41486        NCSTR=-NCSTR
41487        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
41488        NCSTR=13
41489        ICSTR(1:NCSTR)='             '
41490        NCSTR=NCSTR+1
41491        ICSTR(NCSTR:NCSTR)=IQUOTE
41492        NCSTR=NCSTR+1
41493        ICSTR(NCSTR:NCSTR)='>'
41494        NCSTR=-NCSTR
41495        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
41496C
41497      ELSE
41498C
41499        NCSTR=14
41500        ICSTR(1:NCSTR)='        style='
41501        NCSTR=NCSTR+1
41502        ICSTR(NCSTR:NCSTR)=IQUOTE
41503        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
41504C
41505        NCSTR=21
41506        ICSTR(1:NCSTR)='         font-family:'
41507        DO16010I=32,1,-1
41508          NCTEMP=I
41509          IF(ISVGFN(I:I).NE.' ')GOTO16011
4151016010   CONTINUE
4151116011   CONTINUE
41512        NCSTR=NCSTR+1
41513        ICSTR(NCSTR:NCSTR+NCTEMP-1)=ISVGFN(1:NCTEMP)
41514        NCSTR=NCSTR+NCTEMP
41515        ICSTR(NCSTR:NCSTR)=';'
41516        NCSTR=-NCSTR
41517        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
41518        IF(ISVGFW.EQ.'NORM')THEN
41519          NCSTR=28
41520          ICSTR(1:NCSTR)='         font-weight:normal;'
41521          NCSTR=-NCSTR
41522        ELSE
41523          NCSTR=26
41524          ICSTR(1:NCSTR)='         font-weight:bold;'
41525          NCSTR=-NCSTR
41526        ENDIF
41527        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
41528        IF(ISVGST.EQ.'ITAL')THEN
41529          NCSTR=27
41530          ICSTR(1:NCSTR)='         font-style:italic;'
41531          NCSTR=-NCSTR
41532        ELSE
41533          NCSTR=27
41534          ICSTR(1:NCSTR)='         font-style:normal;'
41535          NCSTR=-NCSTR
41536        ENDIF
41537        NCSTR=19
41538        ICSTR(1:NCSTR)='         font-size:'
41539        NCHTOT=3
41540        CALL GRTRIN(JHEIG2,NCHTOT,ICSTR,NCSTR)
41541        NCSTR=NCSTR+1
41542        ICSTR(NCSTR:NCSTR+2)='pt;'
41543        NCSTR=NCSTR+2
41544        NCSTR=-NCSTR
41545        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
41546C
41547        ICSTR(1:27)='         stroke:none;fill:#'
41548        NCSTR=27
41549        NCHTOT=2
41550        JTEMP=JCOL
41551        IF(JTEMP.LE.0)THEN
41552C
41553C         DATAPLOT CURRENTLY ALLOWS GREYSCALE VALUES IN
41554C         THE RANGE 0 TO 100.  FOR SPECIFYING COLOR TO SVG,
41555C         SCALE THAT 0 TO 100 VALUE TO A 0 TO 255 VALUE.
41556C
41557          AVAL=(255./100.)*REAL(ABS(JTEMP))
41558          IF(AVAL.LE.0.0)AVAL=0.0
41559          IF(AVAL.GE.255.0)AVAL=255.0
41560          JRED=INT(AVAL+0.5)
41561          JBLUE=JRED
41562          JGREEN=JRED
41563        ELSE
41564          IF(JTEMP.LT.1 .OR. JTEMP.GT.MAXCLR)JTEMP=1
41565          JRED=IRED(JTEMP)
41566          JGREEN=IGREEN(JTEMP)
41567          JBLUE=IBLUE(JTEMP)
41568        ENDIF
41569        CALL DPCONX(JRED,ICJUNK)
41570        NCSTR=NCSTR+1
41571        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
41572        NCSTR=NCSTR+1
41573        CALL DPCONX(JGREEN,ICJUNK)
41574        NCSTR=NCSTR+1
41575        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
41576        NCSTR=NCSTR+1
41577        CALL DPCONX(JBLUE,ICJUNK)
41578        NCSTR=NCSTR+1
41579        ICSTR(NCSTR:NCSTR+1)=ICJUNK(1:2)
41580        NCSTR=NCSTR+2
41581        ICSTR(NCSTR:NCSTR)=';'
41582C
41583        NCSTR=NCSTR+1
41584        ICSTR(NCSTR:NCSTR)=IQUOTE
41585        NCSTR=NCSTR+1
41586        ICSTR(NCSTR:NCSTR)='>'
41587        NCSTR=-NCSTR
41588        CALL GRWRST(ICSTR,NCSTR,ISUBN0)
41589C
41590      ENDIF
41591C
41592      IF(IX.LE.9)THEN
41593        NCHTOT=1
41594      ELSEIF(IX.LE.99)THEN
41595        NCHTOT=2
41596      ELSEIF(IX.LE.999)THEN
41597        NCHTOT=3
41598      ELSEIF(IX.LE.9999)THEN
41599        NCHTOT=4
41600      ELSE
41601        NCHTOT=5
41602      ENDIF
41603C
41604      ICSTR(1:11)='   <text x='
41605      NCSTR=12
41606      ICSTR(NCSTR:NCSTR)=IQUOTE
41607      NCHTOT=5
41608      CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
41609      NCSTR=NCSTR+1
41610      ICSTR(NCSTR:NCSTR)=IQUOTE
41611      NCSTR=NCSTR+1
41612      ICSTR(NCSTR:NCSTR+2)=' y='
41613      NCSTR=NCSTR+3
41614      ICSTR(NCSTR:NCSTR)=IQUOTE
41615C
41616      IF(IY.LE.9)THEN
41617        NCHTOT=1
41618      ELSEIF(IY.LE.99)THEN
41619        NCHTOT=2
41620      ELSEIF(IY.LE.999)THEN
41621        NCHTOT=3
41622      ELSEIF(IY.LE.9999)THEN
41623        NCHTOT=4
41624      ELSE
41625        NCHTOT=5
41626      ENDIF
41627C
41628      CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR)
41629      NCHTOT=5
41630      NCSTR=NCSTR+1
41631      ICSTR(NCSTR:NCSTR)=IQUOTE
41632      ICSTR(NCSTR+1:NCSTR+7)=' style='
41633      NCSTR=NCSTR+8
41634      ICSTR(NCSTR:NCSTR)=IQUOTE
41635C
41636      IF(IJUST(1:2).EQ.'CE')THEN
41637        ICSTR(NCSTR+1:NCSTR+19)='text-anchor:middle;'
41638        NCSTR=NCSTR+19
41639      ELSEIF(IJUST(1:2).EQ.'RI')THEN
41640        ICSTR(NCSTR+1:NCSTR+16)='text-anchor:end;'
41641        NCSTR=NCSTR+16
41642      ELSE
41643        ICSTR(NCSTR+1:NCSTR+18)='text-anchor:start;'
41644        NCSTR=NCSTR+18
41645      ENDIF
41646C
41647      NCSTR=NCSTR+1
41648      ICSTR(NCSTR:NCSTR)=IQUOTE
41649      NCSTR=NCSTR+1
41650      ICSTR(NCSTR:NCSTR)='>'
41651C
41652C     2012/3: CHECK FOR "<" OR ">".  NEED TO CONVERT THESE TO &lt; AND
41653C             &gt; TO DISTINGUISH THEM FROM TAG IDENTIFIERS.
41654C     2015/11: CHECK FOR "&".  NEED TO CONVERT THESE TO &amp; .
41655C
41656      DO16112J=1,NCTEXT
41657        IF(ICTEXT(J).EQ.'<')THEN
41658          NCSTR=NCSTR+1
41659          ICSTR(NCSTR:NCSTR+3)='&lt;'
41660          NCSTR=NCSTR+3
41661        ELSEIF(ICTEXT(J).EQ.'>')THEN
41662          NCSTR=NCSTR+1
41663          ICSTR(NCSTR:NCSTR+3)='&gt;'
41664          NCSTR=NCSTR+3
41665        ELSEIF(ICTEXT(J).EQ.'&')THEN
41666          NCSTR=NCSTR+1
41667          ICSTR(NCSTR:NCSTR+4)='&amp;'
41668          NCSTR=NCSTR+4
41669        ELSE
41670          NCSTR=NCSTR+1
41671          ICSTR(NCSTR:NCSTR)=ICTEXT(J)
41672        ENDIF
4167316112 CONTINUE
41674C
41675      ICSTR(NCSTR+1:NCSTR+7)='</text>'
41676      NCSTR=NCSTR+7
41677      NCSTR=-NCSTR
41678      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
41679C
41680      ICSTR(1:7)='   </g>'
41681      NCSTR=-7
41682      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
41683C
41684      GOTO9000
41685C
41686C               ******************************************************
41687C               **  STEP 170--                                      **
41688C               **  TREAT THE CAIRO                          DRIVER **
41689C               ******************************************************
41690C
4169117000 CONTINUE
41692#ifdef HAVE_CAIRO
41693C
41694C     CHECK FOR X11 DEVICE, HARDWARE TEXT NOT SUPPORTED
41695C
41696      IVAL1=0
41697      IF(IMODEL.EQ.'X11')IVAL1=1
41698      IVAL2=1
41699      IF(IGUNIT.EQ.IPL1NU)IVAL2=2
41700      IF(IGUNIT.EQ.IPL2NU)IVAL2=3
41701CCCCC IF(IVAL2.EQ.1 .AND. IVAL1.EQ.1)THEN
41702CCCCC   WRITE(ICOUT,999)
41703CCCCC   CALL DPWRST('XXX','BUG ')
41704CCCCC   WRITE(ICOUT,17006)
41705C17006   FORMAT('***** WARNING: HARDWARE TEXT NOT SUPPORTED ON ',
41706CCCCC1         'CAIRO X11 DEVICE.')
41707CCCCC   CALL DPWRST('XXX','BUG ')
41708CCCCC   GOTO9000
41709CCCCC ENDIF
41710C
41711      AX=PX1
41712      AY=PY1
41713      CALL GRTRSD(AX,AY,IX,IY,ISUBN0)
41714C
41715      DO17605I=1,NCTEXT
41716        IC1=ICTEXT(I)(1:1)
41717        CALL DPCOAN(IC1,IJUNK)
41718        STRING(I)=IJUNK
4171917605 CONTINUE
41720      STRING(NCTEXT+1)=0
41721C
41722      ILAST=32
41723      DO17610I=32,1,-1
41724        ILAST=I
41725        IF(ICAIFN(I:I).NE.' ')GOTO17619
4172617610 CONTINUE
4172717619 CONTINUE
41728      DO17620I=1,ILAST
41729        CALL DPCOAN(ICAIFN(I:I),IJUNK)
41730        IADE(I)=IJUNK
4173117620 CONTINUE
41732      IADE(ILAST+1)=0
41733C
41734      IFONTH=0
41735      IFONTV=0
41736      IF(IJUST.EQ.'LEFT')IFONTH=0
41737      IF(IJUST.EQ.'CENT')IFONTH=1
41738      IF(IJUST.EQ.'RIGH')IFONTH=2
41739      IF(IJUST.EQ.'LJUS')IFONTH=0
41740      IF(IJUST.EQ.'CJUS')IFONTH=1
41741      IF(IJUST.EQ.'RJUS')IFONTH=2
41742      IF(IJUST.EQ.'LEBO')IFONTH=0
41743      IF(IJUST.EQ.'CEBO')IFONTH=1
41744      IF(IJUST.EQ.'RIBO')IFONTH=2
41745      IF(IJUST.EQ.'LECE')IFONTH=0
41746      IF(IJUST.EQ.'CECE')IFONTH=1
41747      IF(IJUST.EQ.'RICE')IFONTH=2
41748      IF(IJUST.EQ.'LETO')IFONTH=0
41749      IF(IJUST.EQ.'CETO')IFONTH=1
41750      IF(IJUST.EQ.'RITO')IFONTH=2
41751      IF(IJUST.EQ.'LEFT')IFONTV=1
41752      IF(IJUST.EQ.'CENT')IFONTV=1
41753      IF(IJUST.EQ.'RIGH')IFONTV=1
41754      IF(IJUST.EQ.'LJUS')IFONTV=1
41755      IF(IJUST.EQ.'CJUS')IFONTV=1
41756      IF(IJUST.EQ.'RJUS')IFONTV=1
41757      IF(IJUST.EQ.'LEBO')IFONTV=1
41758      IF(IJUST.EQ.'CEBO')IFONTV=1
41759      IF(IJUST.EQ.'RIBO')IFONTV=1
41760      IF(IJUST.EQ.'LECE')IFONTV=0
41761      IF(IJUST.EQ.'CECE')IFONTV=0
41762      IF(IJUST.EQ.'RICE')IFONTV=0
41763      IF(IJUST.EQ.'LETO')IFONTV=2
41764      IF(IJUST.EQ.'CETO')IFONTV=2
41765      IF(IJUST.EQ.'RITO')IFONTV=2
41766      IERR=0
41767C
41768      IVAL2=1
41769      IF(IGUNIT.EQ.IPL1NU)IVAL2=2
41770      IF(IGUNIT.EQ.IPL2NU)IVAL2=3
41771C
41772      AHEIG2=REAL(JHEIG2)
41773      IVAL3=1
41774      IF(ICAISL.EQ.'ITAL')IVAL3=2
41775      IVAL4=2
41776      IF(ICAIFW.EQ.'BOLD')IVAL4=2
41777      CALL CATXTV(IVAL2,STRING,AX,AY,IFONTH,IFONTV,AHEIG2,
41778     1            IADE,IVAL3,IVAL4,IERR)
41779C
41780#endif
41781      GOTO9000
41782C
41783C               ******************************************************
41784C               **  STEP 180--                                      **
41785C               **  TREAT THE WMF                            DRIVER **
41786C               ******************************************************
41787C
4178818000 CONTINUE
41789      GOTO9000
41790C
41791C               ******************************************************
41792C               **  STEP 190--                                      **
41793C               **  TREAT THE D3                             DRIVER **
41794C               ******************************************************
41795C
4179619000 CONTINUE
41797      GOTO9000
41798C               *****************
41799C               **  STEP 90--  **
41800C               **  EXIT       **
41801C               *****************
41802C
41803 9000 CONTINUE
41804      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'WRTV')THEN
41805        WRITE(ICOUT,999)
41806        CALL DPWRST('XXX','BUG ')
41807        WRITE(ICOUT,9011)
41808 9011   FORMAT('***** AT THE END       OF GRWRTV--')
41809        CALL DPWRST('XXX','BUG ')
41810        WRITE(ICOUT,9035)PXDEL,PYDEL,NCSTR
41811 9035   FORMAT('PXDEL,PYDEL,NCSTR = ',2G15.7,I8)
41812        CALL DPWRST('XXX','BUG ')
41813        WRITE(ICOUT,9036)IC4,IC,IC1,IC2
41814 9036   FORMAT('IC4,IC,IC1,IC2 = ',A4,3(2X,A1))
41815        CALL DPWRST('XXX','BUG ')
41816        WRITE(ICOUT,9037)PXINC,PYINC,PXINC2,PYINC2
41817 9037   FORMAT('PXINC,PYINC,PXINC2,PYINC2 = ',4G15.7)
41818        CALL DPWRST('XXX','BUG ')
41819        IF(NCSTR.GE.1)THEN
41820          DO9045I=1,NCSTR
41821CCCCC       IASCNE=ICHAR(ICSTR(I:I))
41822            CALL DPCOAN(ICSTR(I:I),IASCNE)
41823            WRITE(ICOUT,9046)I,ICSTR(I:I),IASCNE
41824 9046       FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
41825            CALL DPWRST('XXX','BUG ')
41826 9045     CONTINUE
41827        ENDIF
41828        WRITE(ICOUT,9049)IBUGG4,ISUBG4,IERRG4
41829 9049   FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
41830        CALL DPWRST('XXX','BUG ')
41831      ENDIF
41832C
41833      RETURN
41834      END
41835