1C++ CODE for .C. is inactive
2C%% static FILE *inunit, *iotemp, *iotmp1, *iotmp2, *iofil;
3C++ END
4      subroutine DPLOT (XSIZE, YSIZE, X, NX, Y, OPT, COPT)
5c Copyright (c) 1996 California Institute of Technology, Pasadena, CA.
6c ALL RIGHTS RESERVED.
7c Based on Government Sponsored Research NAS7-03001.
8c>> 2009-10-30 DPLOT Krogh -- Initialized ARRLEN & CAPLOC(5:6)
9c>> 2009-10-27 DPLOT Krogh -- BSLAS1 => BSLAS1(1:1) for NAG compiler.
10c>> 2009-10-18 DPLOT Krogh -- Added "save adjin" in dplota
11c>> 2009-06-02 DPLOT  Krogh -- Read from file sets number of points.
12c>> 2005-12-06 DPLOT  Krogh -- Some fixes for conversion to C.
13c>> 2005-05-09 DPLOT  Krogh -- More debug, fixed parens & bad test
14c>> 2001-05-24 DPLOT  Krogh -- Added commas to some formats.
15c>> 2000-01-02 DPLOT   Minor correction to error message text.
16c>> 2000-12-30 DPLOT   Added an (int) cast in some comments for C.
17c>> 2000-10-23 DPLOT   Changed ")/)" to "/)" in a format.
18c>> 2000-01-05 DPLOT   Fixed DPLOTT so IAX is defined before ref.
19c>> 1999-12-27 DPLOT   "Saved" ADJOUT in DPLOTA
20c>> 1999-11-23 DPLOT   Fixed so don't get empty mfpic groups at the end.
21c>> 1998-10-23 DPLOT   Fixed so error index 7 prints.
22c>> 1998-02-02 DPLOT   Work around for bug in HP Exemplar Compiler.
23c>> 1998-01-29 DPLOT   Fixed bug when no output file given.
24c>> 1998-01-21 DPLOT   Work around for \ treated as escape in SGI F77.
25c>> 1998-01-14 DPLOT   Krogh Initial code.
26c--D replaces "?": ?PLOT, ?PLOT0, ?PLOT1, ?PLOT2, ?PLOT4, ?PLOT5,
27c-- &  ?PLOT6, ?PLOT7, ?PLOT8, ?PLOT9, ?PLOTA, ?PLOTB, ?PLOTC, ?PLOTD,
28c-- &  ?PLOTE, ?PLOTF, ?PLOTL, ?PLOTN, ?PLOTR, ?PLOTS, ?PLOTT, ?PLOTU,
29c-- & ?MESS
30C++S Default CTYPE = " (float)"
31C++  Default CTYPE = "(double)"
32C++ Replace "(double)" = CTYPE
33C
34c (DPLOTU picked up and modified from earlier code by Van Snyder).
35c
36c Produce line plots.  Present version produces output for MFpic.
37c
38c *************************** Formal Arguments *************************
39c
40c XSIZE [in] Physical horizontal size of the plot.  Default units are
41c   inches.
42c YSIZE [in] Physical vertical size of the plot.  Default units are
43c   inches.
44c X [in] Array of NX abscissae.
45c NX [in] Number of abscissae in X and ordinates in Y.
46c Y [in] Array of NX ordinates.
47c OPT [inout] OPT(1) is status output:
48c   0.0 means no problems.
49c   0.0 < OPT(1) <= 10000.0 means an option index or parameter at
50c     OPT(nint(OPT(1))) was out of range, had an improper parameter, or
51c     was not permitted at the point it was recognized.
52c   OPT(1) = 10001.0 means the output unit could not be opened.
53c   OPT(1) $<$ 0.0 means an option code at COPT(-nint(OPT(1))) was not
54c     recognized, or had an improper parameter.
55c   Beginning in OPT(2) the user provides option specifications
56c   as described in the main documentation.  (ch16-03.tex)
57c COPT[in] Character options, and character data used by numeric
58c   options.
59c
60c **************** Suggested Parameter Names for Options ***************
61c
62c PLOUNI=1.D0   Units, continue?, logs?, type, etc.
63c PLONY=2.D0    For more than one curve at a time.
64c PLOLIN=3.D0   Type of lines
65c PLOBOR=4.D0   Border characteristics.
66c PLOTIC=5.D0   Tick marks specs.
67c PLOWHT=6.D0   Where the major ticks go.
68c PLOMUL=7.D0   Multiple data sets.
69c PLOXMX=8.D0   Specify X min and max.
70c PLOYMX=9.D0   Specify Y min and max.
71c PLOSYM=10.D0  Specify symbols, error bars, etc. for data points.
72c PLOSY1=11.D0  Specify a single symbol to output.
73c PLOARR=12.D0  Length of arrow head (<0 is leave on till turned off).
74c PLOWID=13.D0  Various line widths
75c PLOTXT=14.D0  A text annotation.
76c PLONUM=15.D0  A number to output.
77c PLOANL=16.D0  An annotation and/or line to output on border or axis
78c PLOBAD=17.D0  For specifying data points to ignore, etc.
79c PLOINP=18.D0  Specifies Fortran input unit.
80c PLOLIN=19.D0  Draw a line.
81c PLOREC=20.D0  Draw a rectangle.
82c PLOELL=21.D0  Draw an ellipse.
83c PLOPLI=22.D0  Draw a line in physical coordinates.
84c PLOPRE=23.D0  Draw a rectangle in physical coordinates.
85c PLOPEL=24.D0  Draw an ellipse in physical coordinates.
86c PLOFIL=25.D0  Specifies filling for various cases.
87c PLORAW=26.D0  Send text directly to the plot file.
88c PLODEB=27.D0  Fortran debugging output.
89c
90c **************************** Procedure Names *************************
91c
92c *******  In this file, DPLOT
93c DPLOT   User entry, defines all actions, processes options, initiator
94c   for all actions.
95c DPLOTA  Determines scalings, draws axes and tick marks, and outputs
96c   axis labels.
97c DPLOTF  Selects points for plotting from those provided by the user
98c   for continuous curves to possibly reduce the number of points
99c   required in the final output.  Also checks and takes care of
100c   clipping.
101c DPLOTN  Takes care of output of numeric labels.
102c DPLOTT  Output of text and checking the size required by text.
103c DPLOTR  Converts XY data for calls to DPLOTS (special symbols)
104c DPLOTU  Opens output and scratch files.
105c
106c *******  In file DPLOT0  (Almost all of the device dependent code.)
107c DPLOT0  Setup for starting a plot.
108c DPLOT1  Specify the pen characteristics.
109c DPLOT2  Draw a single straight line in physical coordinates.
110c DPLOT4  Output an annotation at a given place in physical coordinates.
111c DPLOT5  Draw a rectangle (possibly filled), with pen width given.
112c DPLOT6  Draw a ellipse (possibly filled), with pen width given.
113c DPLOT7  Take care of requests to fill future regions.
114c DPLOT8  Output of tick marks.
115c DPLOT9  Finish the plot.
116c DPLOTL  Plot a line through a sequence of points.  Also for starting
117c   and finishing other types of curves.
118c DPLOTS  Plotting of special symbols, error bars, and vector fields.
119c
120c *************************** Internal Variables ***********************
121c
122c (Here and elsewhere in this package, a "*" following a name is used to
123c indicate the names is in a common block.  Full coverage for variables
124c in the common block only appear here.)
125c
126c ARRLEN* If nonzero, next line or curve is to have an arrow on the end.
127c    This give the length of the arrow in points.
128c BADPT   Logical variable set = .true. if got a point that requires the
129c    curve to be restarted as a result of the bad point.
130c BORLOC* Location of border (physical).
131c C       Temporary single character.
132c CAPTIO  Character array holding captions for borders/axes.
133c DATSAV  Set = .true. when NY > 1 and need to save data on second
134c    scratch file.
135c DEGRAD  Parameter = pi / 180, converts degrees to radians.
136c FILL*   Array giving dot size/space, and hatch info.  First 6 locs.
137c   are for 3 pairs of info for dots,  next 9 for 3 sets of thatch info.
138c FMTNUM Text defining the formatting of numbers (and text).  Indexed
139c    as for LENTXT below.
140c FPIN   Array where floating point data is unpacked.  Also used for
141c    temporary storage.
142c FPDAT  Initial values stored in FP.
143c I      Temporary index.
144c I1     Temporary index.
145c IACT   Index for current action begin processed from LINACT.
146c IAOPT  absolute value of IOPT.  Extra values of:
147c     30   Flags that data for the current set follows.
148c     31   Data for one abscissa follows.
149c     32   Flags a bad data point, next location gives the index for Y.
150c     33   Flags the end of a data set.
151
152c IAX    Used when an axis direction is implied.  1 for x-axis
153c   (horizontal), 2 for y-axis (vertical).
154c IERR   Used for an error index.
155c IERR1  Value to be printed with error message.
156c IERR2  Value of IOP for printing of error messages.
157c IERR3  Index of last char. in COPT that is O.K. for error message.
158c IERR4  Index of last char. in COPT to print with error message.
159c INACT  used to define actions to take for a given option.  The same
160c   actions are used when reading options as when reading the scratch
161c   file but the actions taken may be different.  Each action may be
162c   followed by 0 or more items required by the option.
163c  = 1  Take care of units/final flag & lines at x,y = 0.
164c  = 2  Save border characteristics.  (Includes val. from A3)
165c  = 3  Length of tick marks for various borders.
166c  = 4  Set default ticks for various borders.
167c  = 5  Set ?MAX / ?MIN for current set.
168c  = 6  Check NY.
169c  = 7  Take care of change in data set.
170c  = 8  Set defaults for values .le. 0 on widths.
171c  = 9  Special symbol plotting (may be more than 1 N13)
172c  =10  Single symbol (may require extra args.)
173c  =11  For filling (may have up to 3 for each curve type) (scratch)
174c  =14  There follows in INACT, n, w, p, where
175c         n = number of integers
176c         w = defines where they go when processing options: 1 storage,
177c             2 scratch, 3 both  (NOT USED???)
178c         p = gives index in IP() where integers start.
179c  =15  As for 14, except for floating point data in FP().
180c  =16  Processing for text pointer.  In all cases here, the text is
181c       acted upon immediately when read from the scratch file.
182c       There follows in INACT, t
183c        t =  9 For option 15, Sets format for next numeric output.
184c        t = 16 Text output for options 14 and 16.
185c       On the scratch file this writes, the length of the character
186c       string, and the character string.  If this length is 0, it
187c       simply means that there is no text, and in the case of t=2
188c       and t=3, default actions are to be taken.
189c  =17  Indicates an invalid option index in pass 1.  In pass 2, this
190c       is used for the raw mfpic output.
191c  =18  Take action as implied by the option index when read from the
192c       scratch file.  Possibilities are, a line, a rectangle, an
193c       ellipse, or any of the above in physical coordinates.
194c    Options >17 only occur when reading the scratch file.
195c  =20  Setup to read data.  Following locations give, LKURVE, JSET(1:2)
196c  =21  Shouldn't see where using INACT in pass 2, gives an error.
197c  =22  End of a data set.
198c    Option    INACT for the option
199c       1   1, 14,7,3,NEXT, 14,1,1,LTYPE
200c       2   6, 14,2,3,LYDIM
201c       3   14,1,2,LPEN
202c       4   2
203c       5   3
204c       6   4
205c       7   7
206c       8   5
207c       9   5
208c      10   9
209c      11  10
210c      12  15,1,2,LARROW
211c      13  8,15,4,1,LWIDTH, 15,1,2,LWIDRE
212c      14  15,2,2,LVALS, 14,2,2,LTANNO, 16,16
213c      15  15,3,2,LVALS, 14,2,2,LTANNO, 16,9
214c      16  15,1,2,LVALS, 14,3,2,LTANNO, 16,16
215c      17  15,2,1,LBAD
216c      18  17,
217c      19  15,4,2,LVALS, 18
218c      20  15,4,2,LVALS, 18
219c      21  15,5,2,LVALS, 18
220c      22  15,4,2,LVALS, 18
221c      23  15,4,2,LVALS, 18
222c      24  15,5,2,LVALS, 18
223c      25  11
224c      26  17,
225c      27  14,1,1,LDEBUG
226c ININ   Array where integer point data is unpacked.
227c IOFIL* Unit number used for output to be used for plot device.
228c IOP   Current index in OPT when processing options.
229c IOP1  Starting index in OPT for the current option.  Set to 0 when
230c    processing COPT, set to -1 after processing OPT, and set to -100
231c    - error index on an error.
232c IOPT  Integer value for an option, nint(OPT(IOPT))
233c IOSTA Status of the temporary files.
234c   =  0  There is only one scratch file.  (Needed if digit 10^0 of
235c         option 1 is a 3.)
236c   =  1  There is (or will be) a second scratch file, we are currently
237c         reading from the first one.
238c   = -1  There is a second scratch file and we are reading from it now.
239c IOTEMP Unit number used for scratch file.
240c IOTMP1 If IOSTA .ne. 0, this holds unit number of first scratch file.
241c IOTMP2 If IOSTA .ne. 0, this is the number of the second scratch file.
242c IP*   Integer array used to store various values that are indexed by
243c    parameter names.
244c IPLOT*  Defines output, 0 for LaTeX, 1 for TeX.
245c    Temporarily changed to -100 - IPLOT when want to end one mfpic
246c    group and immediately start another.
247c IRULE  Constant array mapping option indices to location in LRULE.
248c    The value in LRULE and following values up to one less than the
249c    location pointed to by the next location in IRULE indentify actions
250c    in NRULE to used in unpacking data connected with the option if
251c    positive, and if negative identify the number of floating point
252c    numbers for the option.
253c IY     Index for Y curve being output, when outputting the saved data
254c    points.
255c J      Temporary index.
256c JSET*  JSET(1) gives the current set index for X, and JSET(2) gives
257c   the current set index for Y.  JSET(1) starts at 1 and is incrmented,
258c   JSET(2) starts at -1 and is decremented.
259c K1     Temporary index.
260c K2     Temporary index.
261c KPT    Count of points that have been stored in XOUT and YOUT.
262c KX   Pointer e.g. to NXYLIM, for the current data set for X.
263c KY   Pointer e.g. to NXYLIM, for the current data set for Y.
264c KURPEN Rule defining the current pen.  Defined as for P3 of option 3.
265c   KURPEN = t + 10*(w + 100*(L1 + 100*L2)), where t is 0, 1, or 2 for
266c   solid, dotted, or dashed lines.  t = 3 or 4 is as for 1 or 2, except
267c   L1 is given in deci-points instead of points, and t = 5-8, is as for
268c   1-4, except L2 if in deci-points instead of in points.  w is the
269c   width of the line in decipoints, L1 and L2 are not used for solid
270c   lines.  Else L1 is the diameter of the dots or the lenght of the
271c   dashes, and L2 is the distance between the dots or dashes.
272c LKLIP   Set to .true. if the last point saved will be clipped on the
273c   next good point.
274c LFILL  Array with fill pattern info.  Rows are for successive
275c   patterns (usually only one row will be used).  Columns are:
276c       1   For curves
277c       2   For rectangles
278c       3   For ellipses
279c       4   Temporary for annotations.
280c   Values are:
281c       0   For no action, should not be used?
282c       1   For fill with black.
283c       2   For erase what preceded.
284c       3   For shading with dots.
285c       4   For shading with hatch lines.
286c LRULE  See IRULE (and NRULE).
287c K      Temporary index.
288c KASE   1-4 for bottom, left, top,right borders, 5 and 6 for x and y
289c   axis, 8 for words, 10-15 for captions, 16 for output text.
290
291c        Indicees, 1-16, are for: Borders (bottom, left, top, right),
292c   x-axis, y-axis, word alignment (e.g. for option 14), number
293c   formatting for option 15, Captions (as for borders), alignment
294c   rule for option 16.
295c KLIP  Logical array.  Entry is true if this variable set induces
296c    clipping, i.e. some points are outise the plotting area.
297c KSYMB Defines the kind of symbol being plotted.  Passed to DPLOTS.
298c L1     Temporary index.
299c L3     Temporary index.
300c LAST   Defines how called on the last call.  (Low digit of option 1)
301c   = 0-2  Either not called yet, or a plot was finished with units of
302c          inches, millimeters, or points in that order.
303c   = 3    Curve was finished, this MFPIC finished, plot wasn't.
304c   = 4    Curve was finished, plot wasn't.
305c   = 5    Continuing on curve not finished on last call.
306c LBNDC  Parameter giving the maximum number of characters inside {...}
307c    for a caption or a file name.
308c LBNDF  Parameter giving the maximum number of characters inside (...)
309c    for formatting numbers or text.
310c LBNDP  Parameter giving the maximum number of characters inside [...]
311c    for indicating position info.
312c LBNDT  Parameter giving the maximum number of characters inside {...}
313c    for text or number.
314c LBOUND Gives lengths allowed for chars. inside [...] (...), { ...no #
315c    required}.
316c LCURVE Count of the number of curves; not really needed anymore.
317c LENCAP Array giving the length of the caption for borders and axes.
318c LENTXT* Gives the length of various text strings.  Rows are for
319c   FMTNUM, TXTDEF when getting a "#", and after getting all of TXTDEF.
320c   A value of -1 means use the default value.  A value of -2 means the
321c   default is not needed.  Columms are defined as
322c   follows:
323c    1-6     B L T R X Y -- For format of Border/Axis Labels
324c    7       W -- For formatting words
325c    8       N -- For formatting numbers
326c    9       Option 15, format for a number to be output.
327c   10-15    1-6 -- For Border/Axis Captions and formatting.
328c   16       Options 14 & 16, Text to be output.
329c   17       F Output file name or mfpic output
330c   18       Used for temporary storage of text.
331c LINACT Array giving location in INACT where actions for an option
332c   begin (and end).
333c LOCF   Last index used in FPIN when unpacking data.
334c LOCI   Last index used in ININ when unpacking data.
335c LPAR   Used to keep track of paren "{}" level.
336c LSET  Index of the last index available for NXYLIM(), XYLIM(1:2,),
337c   XYBASE(), XYU2PF().
338c LTEXT This location in COPT contains the place where the last text
339c       ended.  Used if annotation has text pointer of 0.
340c LY     The value of IY if not drawing error bars or vector fieles.
341c    Else, LY + 1 is the place where the data for the current curve
342c    starts in FPIN().
343c MANNO* Flags nature of text output.
344c      = -1   Output of annotation in user coordinates.
345c      =  1   Output of annotation in physical coordinates.
346c      =  0   Text output is label, or axis annotation.
347c MAXPT  The dimension of XOUT and YOUT, max value for KPT.
348c MAXNY  Parameter giving the maximum size for NY, should be > 15.
349c MAXSET* Parameter giving the maximum number of data set allowed.
350c MFILL*  Absolute value gives the number of fill patterns.  If < 0,
351c      then filling is not turned off, otherwise it is.
352c MBORD  Defines for the various borders and axes the processing to be
353c   done.  Each column corresponds to a different border or axes.  Other
354c   data depends on the row index as follows.
355c   = 1   From digit 10^0 of option 4 -- Border tick mark actions
356c   = 2   From digit 10^1 of option 4 -- Length of arrow head, points.
357c   = 3   From digit 10^{2} of option 4 -- Min. dist. to border, pts.
358c   = 4   From digit 10^{3:} of option 4 -- Space for labels, points.
359c   = 5   From digit 10^{1:0} of word 2 option 4 -- Number minor ticks.
360c   = 6   From digit 10^2 of word 2 option 4 -- Expand range rule.
361c   = 7   From digit 10^{:3) of word 2 option 4 -- => border caption.
362c   = 8   Value of JSET(?) at time action for border was taken.  Columns
363c         5 and 6 here are used to track extra space needed on left and
364c         right borders needed for annotations.
365c MODE   Defines what we are doing when processing the saved data.
366c   =  0   Interpolate with Bezier curve.
367c   =  1   As for 0, but a closed curve.
368c   =  2   As for 1, but the curve is closed with a straight line.
369c   =  3   Connect points with a straight line.
370c   =  4   As for 2, but close the curve.
371c   =  5   Points not connected, likely to be plotted with symbols.
372c   =  6   Set when points have been connected, and now they are to be
373c          plotted with symbols.
374c   =  7   Plotting single symbols.
375c   =  8   Doing rectangles and ellipses.
376c   =  9   Doing various annotations.
377c   = 10   Ready to exit.
378c MOREIY  Set=.true. if have more in a set of multiple curves to output.
379c NDIMY   Declared dimension of Y (used only when NY > 1)
380c NMODE  Defines how we start MODE when done with what we are doing now.
381c   NMODE is intialized to 10, and is never increased, and is never set
382c   smaller or equal to MODE.
383c NOOUT*  Set to .true. when there is no output desired (just getting
384c   size required).
385c NOTOUT Set .true. when starting to process an option.  Set false when
386c   first write the option index to the scratch file.  Also used when
387c   checking if input file is opened.
388c NRULE()   Unpacking rules.  Integers are unpacked by taking the mod
389c   if the integer relative to the value pointed to in NRULE.  This
390c   result is saved, the original integer is divided by this same value
391c   from NRULE, and the process continues until getting a value of 0, at
392c   which time the current integer is saved, and the integer has been
393c   unpacked.  This gives integers in the same order as they appear in
394c   the documentation.
395c NTEXT* The length of the text in TEXT.
396c NTYP   Defines the type of text we are looking for.
397c   = 1   Position info
398c   = 2   Format
399c   = 3   Text/number formatting info, before any "#".
400c   = 4   Text/number formatting info, after getttng a "#".
401c NXYLIM*Array defining what is in the columns of XYLIM and entries in
402c   XYU2PF and XYBASE..  If > 0, contains the index for an XDATA set.
403c   If < 0, contains the index for a Y data set.  If 0, no data for this
404c   data set has been examined.
405c NY      Number of curves being plotted.
406c OPAQUE* .true. if the label printed is to go into an opaque box.
407c OPTLET  Constant character string used to decode option letters.
408c OVLAP  Estimated right end of last output number.  If a numeric
409c   label looks as if it will overlap with a previous one, it is not
410c   printed.
411c PHYUSE* Set by option 7.  Columns 1 and 2 for x and y, row 1 gives
412c   give place in physical units where points are to map, and row 2
413c   give the corresponding user coordinate.  Row < 0 inactivates.
414c POS*    Character array holding alignment info.  POS(4*I-3:4*I) for
415c   I = 1, 16, holds data for: Borders (bottom, left, top, right),
416c   x-axis, y-axis, word alignment (e.g. for option 14), number
417c   formatting for option 15, Captions (as for borders), alignment
418c   rule for option 16.
419c PXO*    X origin of logical coordinate system in physical units.
420c PXSIZE* Physical X width of the plot, including outward-pointing tick
421c         marks.
422c PYO*    Y origin of logical coordinate system in physical units.
423c PYSIZE* Physical Y width of the plot, including outward-pointing tick
424c         marks.
425c SETLIM* Col. 1 for x, 2 for y, row 1 for min, 2 for max.  Give min and
426c   max used for current data set.  If the log of the data is taken,
427c   these values will be the logs of the input values.
428c TEXT* Text to be output.
429c TICKS Columns for different borders/axes.  Rows used as follows:
430c   = 1  Length of major ticks.
431c   = 2  Length of minor ticks.
432c   = 3  Offset for major ticks  (Ignore if incrment below is .le. 0)
433c   = 4  Increment for major ticks
434c TLENH  Set to horizontal length of text in DPLOTN
435c TLENV  Set to vertical height of text in DPLOTN.
436c TOPTS* Multiplies physical coordinates to get them in units of points.
437c TP     Used for tempoaray floating point storage.
438c TP1    Used for tempoaray floating point storage.
439c TP2    Used for tempoaray floating point storage.
440c TPTSET Data used to set TOPTS.
441c TXTDEF Text used to control output of text and numbers.
442c TXTTST Constant character array indexed by NTYP used to detect escaped
443c   characters and to track the level of "{}"'s.
444c VHLEN  Array giving the vertical and horizontal space required by
445c   output text, set in DPLOTT.
446c XOUT   Array used to save absiccas that are ready for output.
447c YOUT   Array used to save absiccas that are ready for output.
448c XYBASE* See XYU2PF and NXYLIM.
449c XYLIM* Rows 1 and 2 contain "minimum value", "maximum value" Columns:
450c   1  From the current X data and perhaps XYMAX and XYMIN.
451c   2  From the current Y data and perhaps XYMAX and XYMIN.
452c  >k  From previous data sets (option 7).  See NXYLIM.
453c   Originally contains min/max determined from the data.  Can be
454c   changed to SETLIM when clipping is active.  This is changed to
455c   physical address value when axis is processed.
456c XYMAX  Maximum values set by options 8 and 9, used to set SETLIM.
457c XYMIN  Minimum values set by options 8 and 9, used to set SETLIM.
458c XYPOS  Use to hold (x,y) position information.
459c XYU2PF* Array giving multipliers for converting from user to physical
460c    coordinates.  Entries correspond to either an x or a y data set.
461c    Let v be the x or y corresponding to XYU2PF(I) (see NXYLIM).  Then
462c    v_{physical} = XYBASE(IAX) + v_{user} * XYU2PF(IAX).  If an entry
463c    here is nonzero, its value has been determined.
464
465c Parameter defs (integers) (in IP):
466c NEXT   10^0 of Opt. 1 -- Units, continue, etc., sets LAST.
467c INTERP 10^1 of Opt. 1 -- Connecting points of a curve
468c KSET   Opt. 7 -- Current user coordinate set
469c LCOOX  10^2 of Opt. 1 -- Type of coordinate X.  A value of 3 is
470c    set to 2 to make checking for log transformations simpler.
471c LCOOY  10^3 of Opt. 1 -- Type of coordinate Y.  As for X above.
472c LDEBUG Opt. 25 -- Debugging print flag.
473c LNY    Opt. 2  -- Number of y curves being plotted
474c LYDIM  Opt. 2  -- First dimension of Y when NY > 1.
475c LPEN   Opt. 3  -- Type of pen
476c LTANNO Opts. 14,15 -- Type of coordinates amd OPAQUE, Text pointer
477c      In the case of Opt. 16, give tick, border index, pointer to text.
478c LTYPE  10^5 of Opt. 1 -- LaTeX, or TeX
479c LXBORD From Opt. 1 -- For how horizontal borders and axis are labeled.
480c         = 0 Linear
481c         = 1 10^{??} For log labeling
482c         = 2 Polar in radians (Later??)
483c         = 3 Polar in degrees (Later??)
484c LXLINE 10^4 of Opt. 1 -- Drawing extra lines
485c LYBORD As for LXBORD, except for vertical case.
486c NBORD  Opt. 16 -- Index for the border.
487c Parameter defs (floating point):
488c LARROW Opt. 12 -- Length of arrow head in points
489c LBAD(2) Opt. 17 -- Flag on bad data action, and the value.
490c LXYSIZ             This and next give XSIZE and YSIZE.
491c LASTFP             Gives Last location used in FP.
492c LVALS (5) Options 14-16, 20-23 -- Place to save various temp. values.
493c LWIDRE Opt. 13 -- Line width for rectangles and ellipses.
494c LWIDTH (4) Opt. 13 -- Type of pen for borders, major ticks, minor
495c     ticks, and lines drawn at x=0 or y=0.
496c LASTFP             Size of the array FP().
497c LFDAT              Size of the array FPDAT.
498c Parameters for integers in IP
499c  INTERP,LCOOX,LCOOY,LXLINE,LTYPE,LXBORD,LYBORD, KSET, LTANNO,
500c  LPEN,NBORD, LDEBUG
501c
502c Parameters for floating point
503c  LARROW, LWIDTH (4), LWIDRE
504c  LVALS (5), LBAD(2)
505c
506c **************************** Variable Declarations *******************
507c
508c Formal Args.
509      double precision XSIZE, YSIZE, X(*), Y(*), OPT(*)
510      integer NX
511      character COPT*(*)
512c Common
513c  For DPLOT0
514      double precision ARRLEN, PXO, PXSIZE, PYO, PYSIZE
515C++ CODE for ~.C. is active
516      integer IOFIL, IPLOT, KURPEN, LASPEN
517      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
518     1   IOFIL, IPLOT, KURPEN, LASPEN
519C++ CODE for .C. is inactive
520C%%    long ictmp;
521C      integer IPLOT, KURPEN, LASPEN
522C      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
523C     1   IPLOT, KURPEN, LASPEN
524C++ END
525      save /DPLOTD/
526c
527c         Parameter pointers for integers in IP.
528      integer NEXT, INTERP, LCOOX,LCOOY,LXLINE,LXBORD,LYBORD, LTYPE,
529     1  KSET, LTANNO, LPEN, NBORD, LYDIM, LNY, LDEBUG,
530     2  LASTIP
531      parameter (NEXT=1, INTERP=2, LCOOX=3, LCOOY=4, LXLINE=5,
532     1  LXBORD=6, LYBORD=7, LTYPE=8, KSET=9, LTANNO=10, LPEN=13,
533     2  NBORD=14, LYDIM=15, LNY=16, LDEBUG=18, LASTIP=LDEBUG)
534c          Parameter pointers for floats in FP.
535      integer LARROW,LWIDTH,LWIDRE,LBAD,LVALS,LXYSIZ,LASTFP,LFDAT
536      parameter (LARROW=1, LWIDTH=2, LWIDRE=6, LBAD=7,
537     1  LVALS=9, LXYSIZ=LVALS+5, LASTFP=LXYSIZ+2,LFDAT=LBAD)
538c          Parameter for various sizes.
539      integer LBNDC, LBNDF, LBNDP, LBNDT, MAXSET
540      parameter (LBNDC=128, LBNDF=32, LBNDP=4, LBNDT=64, MAXSET=20)
541      double precision BORLOC(6), FILL(19), FP(LASTFP), OVLAP,
542     1  PHYUSE(2,2), SETLIM(2,2), TLENH, TLENV, TICKS(4,6), TOPTS,
543     2  VHLEN(2), XYBASE(MAXSET), XYLIM(2,MAXSET), XYU2PF(MAXSET)
544      integer IERR1, IERR2, IERR3, IERR4, IOP1, IP(LASTIP), JSET(2),
545     1  LENCAP(6), LENTXT(3,18), MANNO, MBORD(8,6), MFILL(4), NTEXT,
546     2  NXYLIM(MAXSET)
547      logical  KLIP(MAXSET), NOOUT, OPAQUE
548      common / DPLOTB / BORLOC, FILL, FP, OVLAP, PHYUSE, SETLIM, TICKS,
549     1  TLENH, TLENV, TOPTS, VHLEN, XYBASE, XYLIM, XYU2PF, IERR1,
550     2  IERR2, IERR3, IERR4, IOP1, IP, JSET, LENCAP, LENTXT, MANNO,
551     3  MBORD, NTEXT, NXYLIM, KLIP, MFILL, NOOUT, OPAQUE
552c
553      character FMTNUM(17)*(LBNDF), CAPTIO(6)*(LBNDC), POS*68, TEXT*280,
554     1    TXTDEF(18)*(LBNDT)
555      common / DPLOTC / FMTNUM, CAPTIO, POS, TEXT, TXTDEF
556      save /DPLOTB/, /DPLOTC/
557c Locals
558      integer MAXNY, MAXPT
559      parameter (MAXNY=50, MAXPT=101)
560C++ CODE for .C. is inactive
561C      integer I, I1, IACT, IAOPT, IAX, IERR,
562C++ CODE for ~.C. is active
563      integer INUNIT, IOTEMP, IOTMP1, IOTMP2, I, I1, IACT, IAOPT,
564C++ END
565     1   IAX, IERR, INACT(114), ININ(MAXNY), IOP, IOPT, IOSTA,
566     2  IRULE(28), IY, J, K, K1, K2, KPT, KSYMB, KX, KY, L, L1, L3,
567     3  LAST, LBOUND(3), LCURVE, LFILL(3,4), LINACT(34), LOCF, LOCI,
568     4  LPAR, LRULE(35), LSET, LTEXT, LY, M, MODE, NDIMY, NMODE,
569     5  NRULE(18), NTYP, NXI, NY
570      double precision FPDAT(LFDAT), FPIN(MAXNY), TP, TP1, TP2,
571     1   TPTSET(3), XOUT(MAXPT), XYMAX(2), XYMIN(2), XYPOS(2),
572     2   YOUT(MAXPT)
573      character BNDTST*4, C, HLET*6, TXTTST(4)*4, OPTLET*38, VLET*6
574      logical BADPT, DATSAV, LKLIP, MOREIY, NOTOUT
575c
576c Weird stuff to take care of "\" being treated as an escape character
577c on SGI Fortran compilers
578C++ CODE for ~.C. is active
579      character BSLAS1*(*), BSLASH
580      parameter (BSLAS1 = '\\')
581      parameter (BSLASH = BSLAS1(1:1))
582c
583      character*4 TXTTS1, TXTTS2, TXTTS3, TXTTS4
584      parameter (TXTTS1=BSLASH//']]]', TXTTS2=BSLASH//')))',
585     1   TXTTS3=BSLASH//'{#}', TXTTS4=BSLASH//'{{}')
586
587c         For debug printing
588      character DB*1
589
590C++ CODE for .C. is inactive
591C      character BSLASH
592C      parameter (BSLASH='\\')
593C++END
594c
595C++ CODE for .C. is inactive
596C      save IOSTA, LCURVE, LAST, LSET, XYMAX, XYMIN
597C++ CODE for ~.C. is active
598      save INUNIT, IOSTA, IOTEMP, LCURVE, LAST, LSET, XYMAX, XYMIN
599C++ END
600
601c Option Index:    1  2  3  4  5   6   7   8   9  10  11  12  13  14
602c       15  16  17  18  19  20  21  22  23  24  25  26  27 <end flag>
603      data IRULE / 1, 2, 4, 5, 8, 10, 12, 16, 17, 18, 18, 19, 20, 21,
604     2  23, 25, 27, 28, 28, 29, 30, 31, 32, 33, 34, 35, 35, 36 /
605
606c Index from IRULE:1   2    4  5        8    10    12         16  17
607c       18  19  20  21    23    25    27  28  29  30  31  32  33  34 35
608      data LRULE / 2,  7,7, 7, 7,15,12, 7,-2, 7,-2, 6,4,9,-2, -2, -2,
609     1  -2, -1, -5, -2,6, -3,6, -1,5, -2, -4, -4, -5, -4, -4, -5, 5, 7 /
610
611c                 1   2   3   4   5   6  7   8    9   10 11   12  13 14
612c        15  16   17 18
613      data NRULE/10, 10, 10, 10, 10, 10, 0, 10, 100, 100, 0, 100, 10, 0,
614     1   10, 10, 100, 0 /
615
616c                   1   2   3   4   5   6   7   8   9  10  11  12  13
617c       14  15  16  17  18  19  20  21  22  23   24   25   26   27   28
618c       29,  30   31   32   33 end
619      data LINACT / 1, 10, 15, 19, 20, 21, 22, 23, 24, 25, 26, 27, 31,
620     1  40, 50, 60, 70, 74, 75, 80, 85, 90, 95, 100, 105, 106, 107, 111,
621     2 111, 112, 113, 113, 114, 115 /
622
623      data INACT / 1, 14,7,3,NEXT, 14,1,1,LTYPE,
624     1   6, 14,2,3,LYDIM,
625     2  14,1,2,LPEN,
626     3   2,  3,  4,   7,  5,  5,  9,  10,
627     4  15,1,2,LARROW,
628     5   8,15,4,1,LWIDTH, 15,1,2,LWIDRE,
629     6  15,2,2,LVALS, 14,2,2,LTANNO, 16,16,
630     7  15,3,2,LVALS, 14,2,2,LTANNO, 16,9,
631     8  15,1,2,LVALS, 14,3,2,LTANNO, 16,16,
632     9  15,2,1,LBAD,
633     A  17,
634     B  15,4,2,LVALS, 18,   15,4,2,LVALS, 18,
635     C  15,5,2,LVALS, 18,   15,4,2,LVALS, 18,
636     D  15,4,2,LVALS, 18,   15,5,2,LVALS, 18,
637     F  11,
638     G  17,
639     H  14,1,1,LDEBUG,
640     I  17, 20, 21, 22 /
641
642      data LAST / 0 /
643c                             11111111112222222222333333333
644c                    12345678901234567890123456789012345678
645      data OPTLET / 'QMIFACBLTRXYWN 123456({[qmifacbltrxywn' /
646c                    1234
647      data BNDTST / '[({#' /
648C++ CODE for ~.C. is active
649      data TXTTST / TXTTS1, TXTTS2, TXTTS3, TXTTS4 /
650C++ CODE for .C. is inactive
651c      data TXTTST / '\]]]', '\)))', '\{#}', '\{{}' /
652C++ END
653      data VLET / 'tcbTCB' /
654      data HLET / 'lcrLCR' /
655c Initial FP.        1    2     3    4   5     6      7
656      data FPDAT / 4.D0,100.D0,.7D0,.5D0,60.D0,30.D0,-1.D0 /
657
658      data LBOUND / LBNDP, LBNDF, LBNDT /
659c
660c To get TOPTS.
661         data TPTSET / 72.27D0, 2.845D0, 1.D0 /
662C++ CODE for ~.C. is active
663   10 format(1X, A1, I3, ' IAOPT=',I2,'  Len=',I3, '  POS=',A4)
664   20 format(1X, A1, I3, ' IAOPT=',I2,' FMTNUM=', A)
665   30 format(1X, A1, I3, ' IAOPT=',I2,' TEXT=', A)
666   40 format(1X, A1, I3, ' IAOPT=',I2,'LENTXT=',3I4, '   POS=', A4)
667   50 format(1X, A1, I3, ' IAOPT=',I2,'  Symbols:', 6I10 / (10X,6I10))
668   60 format(1X, A1, I3, ' IAOPT=',I2, 1P,2E16.7, I10/ (4E16.7))
669   70 format(1X, A1, I3, ' IAOPT=',I2, 3I4, 1P,5E16.7)
670   80 format(1X, A1, I3, ' IAOPT=',I2, '  Integers:', 10I8)
671   90 format(1X, A1, I3, ' IAOPT=',I2, '  F.P.:', 1P,6E17.8)
672  120 format(1X, A1, I3, ' IAOPT=',I2, 1P,4E16.7 / (8X, 4E16.7))
673  130 format(1X, A1, I3, ' New data set, Curve=', I3, '  KX=',I3,
674     1  '  KY=',I3: '   MODE=', I2, '   IY=', I2, '   NY=', I2)
675C++ CODE for .C. is inactive
676C%%   const char fmt10[] = "IAOPT=%li  Len=%li  POS=%.4s\n";
677C%%   const char fmt20[] = "IAOPT=%li  FMTNUM=%.*s\n";
678C%%   const char fmt30[] = "IAOPT=%li  TEXT=%.*s\n";
679C%%   const char fmt40[] = "IAOPT=%li  LENTXT=%4li%4li%4li  POS=%.4s\n";
680C%%   const char fmt50[] = "IAOPT=%li  Symbols:";
681C%%   const char fmt55[] = "%10li";
682C%%   const char fmt60[] = "IAOPT=%li%16.7e%16.7e  %li\n";
683C%%   const char fmt65[] = "%16.7e";
684C%%   const char fmt70[] = "IAOPT=%li%4li%4li%4li";
685C%%   const char fmt80[] = "IAOPT=%li  Integers:";
686C%%   const char fmt85[] = "%8li";
687C%%   const char fmt90[] = "IAOPT=%li  F.P.:";
688C%%   const char fmt95[] = "%17.8e";
689C%%   const char fmt120[]= "IAOPT=%li";
690C%%   const char fmt125[]= "%15.7e";
691C%%   const char fmt130[]= "New data set, Curve=%3li  KX=%3li  KY=%3li\
692C%%   MODE=%2li   IY=%2li  NY=%2li\n";
693C++ END
694
695c
696c ************************ Start of Executable Code ********************
697c
698c Set the defaults as needed.
699C++ CODE for ~.C. is active
700      INUNIT = 0
701C++ END
702      OPT(1) = 0.D0
703      IOP1 = 0
704      NXI = NX
705      if (LAST .le. 4) then
706c                     Set the defaults
707         if (LAST .le. 2) then
708            TXTDEF(17)= 'dplot.tex'
709            ARRLEN = 0
710            LCURVE = 100
711            JSET(1) = 1
712            JSET(2) = -1
713            NXYLIM(1) = 0
714            NXYLIM(2) = 0
715            XYU2PF(1) = 0.D0
716            XYU2PF(2) = 0.D0
717            XYMIN(1) = 0.D0
718            XYMAX(1) = 0.D0
719            XYMIN(2) = 0.D0
720            XYMAX(2) = 0.D0
721            SETLIM(1, 1) = 0.D0
722            SETLIM(2, 1) = 0.D0
723            SETLIM(1, 2) = 0.D0
724            SETLIM(2, 2) = 0.D0
725            PHYUSE(1, 1) = -1.D0
726            PHYUSE(1, 2) = -1.D0
727            LSET = 2
728c                    B   L   T   R   X   Y   W   N  o15  1   2   3   4
729c      5   6  o16
730            POS =  'bc..cr..bc..cl..bc..cr..bl..cl..cl..bc..cr..bc..cl..
731     1rc..tc..lc..  ..'
732c                    Flag that FMTNUM and TXTDEF are not needed.
733            do 140 I = 1, 17
734               LENTXT(1, I) = -1
735               LENTXT(2, I) = 0
736               LENTXT(3, I) = -1
737  140       continue
738            LENTXT(3, 17) = 9
739c                              Default border actions
740            do 160 I = 1, 6
741               do 150 J = 1, 8
742                  MBORD(J, I) = 0
743  150          continue
744  160       continue
745            MBORD(1,1) = 6
746            MBORD(1,2) = 6
747            MBORD(1,3) = 1
748            MBORD(1,4) = 1
749            MBORD(8,1) = 0
750c     Default tick lengths, no captions
751            do 170 I = 1, 6
752               TICKS(1, I) = 4.0D0
753               TICKS(2, I) = 2.5D0
754               TICKS(3, I) = 0.0D0
755               TICKS(4, I) = 0.0D0
756               LENCAP(I) = 0
757  170       continue
758
759c                              Initialize IP and FP
760            do 180 I = 1, LASTIP
761              IP(I) = 0
762  180       continue
763            IP(LNY) = 1
764            IP(LPEN) = 50
765            do 190 I = 1, LFDAT
766              FP(I) = FPDAT(I)
767  190       continue
768c                              Open the scratch file.
769C++ CODE for ~.C. is active
770            call DPLOTU (IOTEMP, ' ')
771            if (IOP1 .le. -100) go to 1500
772            DB = 'W'
773C++ CODE for .C. is inactive
774C%%         iotemp = tmpfile();
775C%%         if (iotemp == NULL) goto L_1500;
776C++ END
777            IOSTA = 0
778            MANNO = 0
779         else
780            IP(NEXT) = 0
781         end if
782      end if
783      FP(LXYSIZ) = XSIZE
784      FP(LXYSIZ+1) = YSIZE
785c
786c ********************** Process the options in COPT *******************
787c
788      LTEXT = 0
789  200 LTEXT = LTEXT + 1
790      C = COPT(LTEXT:LTEXT)
791      if (C .eq. ' ') go to 200
792      K = index(OPTLET, C)
793      if (K .eq. 0) then
794c                       Error -- Bad option character
795         IERR = 10
796         go to 1400
797      end if
798      if (K .gt. 20) K = K - 24
799      if (K .le. 1) go to 290
800      NTYP = 2
801      K = K - 6
802c  Enter here when processing text pointed to by options in OPT.
803c                Remember start at I1 for error messages.
804  210 I1 = LTEXT
805      K1 = K
806      if (K .le. 0) then
807         if (K .le. -2) then
808c                Getting file name (or mfpic output)
809            NTYP = 3
810            K1 = 19 + K
811            K = 17
812         else if (K .ne. 0) then
813c                Got an A, set to save data in first border.
814            K = 1
815         else
816c                Defaults for captions
817            K = 10
818         end if
819
820      else if (K .ge. 8) then
821         NTYP = 1
822      end if
823c At this point, K identifies what we are working on as follows.
824c   = 1-6     B L T R X Y -- For format of Border/Axis Labels
825c   = 7       W -- For formatting words
826c   = 8       N -- For formatting numbers
827c   = 9       Option 15, format for a number to be output.
828c   =10-15    1-6 -- For Border/Axis Captions (or for "C")
829c   =16       Options 14 & 16, Text to be output.
830c   =17       F -- Output file name or mfpic output
831      LENTXT(1, K) = -1
832      LENTXT(3, K) = -1
833  220 LTEXT = LTEXT + 1
834c                Checking
835      C = COPT(LTEXT:LTEXT)
836C%%   k2 = 0;
837C%%   for (j=0; j<4; j++) {
838C%%      if (bndtst[j] == c) {
839C%%        k2 = j + 1;
840C%%        break;}}
841      K2 = index(BNDTST(NTYP:4), C)
842      if (K2 .eq. 0) then
843         if (C .eq. ' ') go to 220
844c                        Error -- Bad start of COPT option
845         IERR = 11
846         go to 1400
847      end if
848      if (K2 .ne. 1) then
849         if (C .eq. '#') then
850            if (K .lt. 10) go to 260
851c                        Error -- Bad start of COPT option
852            IERR = 11
853            go to 1400
854         end if
855         NTYP = NTYP + K2 - 1
856      end if
857      if ((C .eq. '{') .and. (K1 .ge. 10)) then
858         NTYP = 4
859         if (COPT(LTEXT+1:LTEXT+1) .eq. BSLASH) LENTXT(3, K) = -2
860      end if
861      LPAR = 1
862      J = LTEXT
863  240 LTEXT = LTEXT + 1
864      if (LTEXT - I1 .gt. 100) then
865c                 Error -- Runaway in COPT, unbalanced (), [], or {}?
866         J = I1
867         IERR = 12
868         go to 1410
869      end if
870c                    Get the end tag (LPAR counts "paren" levels)
871      C = COPT(LTEXT:LTEXT)
872      L = index(TXTTST(NTYP), C)
873c          Skip uninteresting characters, and those escaped with '\'.
874      if (L .eq. 1) LTEXT = LTEXT + 1
875      if (L .le. 1) go to 240
876      if (NTYP .ge. 3) then
877         if (L .ne. 3) then
878            LPAR = LPAR - L + 3
879            if (LPAR .ne. 0) go to 240
880            if (NTYP .eq. 3) then
881c                            Error -- Missing #
882               IERR = 13
883               go to 1400
884            end if
885         else
886            if (NTYP .eq. 3) then
887               LENTXT(2, K) = LTEXT - J
888               NTYP = NTYP + 1
889            end if
890            go to 240
891         end if
892c                      Save the length
893         L = LTEXT - J - 1
894         if ((K .ge. 10) .and. (K1 .ne. 0)) then
895c               Text for file name or border/axis caption or option
896            if (L .le. 0) then
897c                         Error -- File name or caption is empty
898               IERR = 14
899               go to 1400
900            end if
901            if (L .gt. LBNDC) then
902c                       Error -- (J:LTEXT) may only contain LBNDC chars.
903               IERR1 = LBNDC
904               IERR = 15
905               go to 1410
906            end if
907            if (K .eq. 17) then
908               if (K1 .eq. 17) then
909c                             The output file name.
910                  LENTXT(3,17) = L
911C%%               memcpy(dplotc.txtdef[16], copt+j,(size_t)l);
912C%%               dplotc.txtdef[16][l]='\0';
913                  TXTDEF(17) = COPT(J+1:LTEXT-1)
914               else if (K1 .eq. 16) then
915c          The input file name, get the unit number, open if needed.
916C++ CODE for ~.C. is active
917                  inquire(FILE=COPT(J+1:LTEXT-1), NUMBER=INUNIT,
918     1                OPENED=NOTOUT)
919                  if (.not. NOTOUT) then
920                     call DPLOTU(INUNIT,COPT(J+1:LTEXT-1))
921                     if (IOP1 .le. -100) go to 1500
922                  end if
923C++ CODE for .C. is inactive
924C                 C = COPT(LTEXT:LTEXT)
925C%%               copt[ltext-1] = '\0';
926C%%               inunit = fopen(copt+j, "r");
927C%%               if (inunit == NULL) goto L_1500;
928C                 COPT(LTEXT:LTEXT) = C
929C++ END
930               else
931c                             Data for raw mfpic output.
932C%%               ictmp = 29;
933C%%               fwrite(&ictmp, sizeof(ictmp), (size_t)1, iotemp);
934                  write (IOTEMP) 29
935C%%               fwrite(&l, sizeof(l), (size_t)1, iotemp);
936c%%               fwrite(copt+j, (size_t)1, (size_t)l, iotemp);
937                  write (IOTEMP) L, COPT(J+1: LTEXT-1)
938               end if
939               go to 200
940            end if
941            if (K .ge. 16) then
942c                            Option 14, or 16, text to output.
943              if (NOTOUT) then
944                 NOTOUT = .false.
945C%%              fwrite(&iaopt, sizeof(iaopt), (size_t)1, iotemp);
946                 write (IOTEMP) IAOPT
947              end if
948C%%           fwrite(&dplotb.lentxt[k-1][0],
949C%%               sizeof(dplotb.lentxt[k-1][0]),(size_t)1,iotemp);
950C%%           fwrite(&l, sizeof(l), (size_t)1, iotemp);
951C%%           fwrite(&dplotc.pos[60], (size_t)1, (size_t)4, iotemp);
952              write (IOTEMP) LENTXT(1, K), L, POS(61:64)
953C++ CODE for .C. is inactive
954C%%           if (dplotb.ip[LDEBUG-1] > 1) printf (fmt10, iaopt,
955C%%             dplotb.lentxt[k-1][0], &dplotc.pos[60]);
956C++ CODE for ~.C. is active
957              if (IP(LDEBUG).gt.1)
958     1          print 10, DB, IOTEMP, IAOPT,LENTXT(1,K),POS(61:64)
959C++ END
960              if (LENTXT(1,K) .gt. 0) then
961C++ CODE for ~.C. is active
962                 write (IOTEMP) FMTNUM(K)(1:LENTXT(1,K))
963                 if (IP(LDEBUG).gt.1)
964     1              print 20, DB,IOTEMP,IAOPT,FMTNUM(K)(1:LENTXT(1,K))
965C++ CODE for .C. is inactive
966c%%               fwrite(dplotc.fmtnum[k-1], (size_t)1,
967c%%                  (size_t)dplotb.lentxt[k-1][0], iotemp);
968C%%               if (dplotb.ip[LDEBUG-1] > 1) printf (fmt20, iaopt,
969C%%                  (int)dplotb.lentxt[k-1][0], dplotc.fmtnum[k-1]);
970C++ END
971              end  if
972              if (L .ne. 0) then
973c%%              fwrite(copt+j, (size_t)1, (size_t)l, iotemp);
974                 write (IOTEMP) COPT(J+1:LTEXT-1)
975C++ CODE for .C. is inactive
976C%%              if (dplotb.ip[LDEBUG-1] > 1) printf (fmt30, iaopt,
977C%%                 (int)l, copt+j);
978C++ CODE for ~.C. is active
979                 if (IP(LDEBUG).gt.1)
980     1             print 30, DB, IOTEMP, IAOPT,COPT(J+1:LTEXT-1)
981C++ END
982              end if
983              go to 400
984            else
985               LENCAP(K-9) = L
986C%%            memcpy(dplotc.captio[k-10], copt+j,(size_t)(ltext-j-1));
987               CAPTIO(K-9) = COPT(J+1:LTEXT-1)
988            end if
989         end if
990      else
991         L = LTEXT - J - 1
992         if (L .gt. LBOUND(NTYP)) then
993c                Error -- (J:LTEXT) may only contain LBOUND(NTYP) chars.
994               IERR1 = LBOUND(NTYP)
995               IERR = 15
996               go to 1410
997         end if
998         if (NTYP .eq. 1) then
999c                          Check and save position info.
1000            if ((L .ne. 2) .and. (L .ne. 4)) then
1001c                             Error -- [...] must contain 2 or 4 letters
1002               IERR = 16
1003               go to 1410
1004            end if
1005            C = COPT(J+1:J+1)
1006            I = index(VLET, C)
1007            if (I .eq. 0) then
1008c                        Error -- First position must be one of "tcbTCB"
1009               IERR = 17
1010               go to 1410
1011            end if
1012            if (I .gt. 3) C = VLET(I-3:I-3)
1013            POS(4*K-3:4*K-3) = C
1014            C = COPT(J+2:J+2)
1015            I = index(HLET, C)
1016            if (I .eq. 0) then
1017c                       Error -- Second position must be one of "lcrLCR"
1018               IERR = 18
1019               go to 1410
1020            end if
1021            if (I .gt. 3) C = HLET(I-3:I-3)
1022            POS(4*K-2:4*K-2) = C
1023            if (L .eq. 2) then
1024               POS(4*K-1:4*K) = '  '
1025            else
1026               C = COPT(J+4:J+4)
1027               I = index(HLET, C)
1028               if (I .gt. 3) C = HLET(I-3:I-3)
1029               if((I .eq. 0) .or. ((COPT(J+2:J+2) .ne. 'S') .and.
1030     1             (COPT(J+2:J+2) .ne. 's'))) then
1031c                              Error -- In third/forth position of [...]
1032                  IERR = 19
1033                  go to 1410
1034               end if
1035               POS(4*K-1:4*K-1) = 's'
1036               POS(4*K:4*K) = C
1037            end if
1038            go to 250
1039         end if
1040         LENTXT(NTYP-1, K) = L
1041         if (L .ne. 0) then
1042            if (NTYP .eq. 2) then
1043C%%            memcpy(dplotc.fmtnum[k-1], copt+j,(size_t)(ltext-j-1));
1044               FMTNUM(K) = COPT(J+1:LTEXT-1)
1045            else
1046C%%            memcpy(dplotc.txtdef[k-1], copt+j,(size_t)(ltext-j-1));
1047               TXTDEF(K) = COPT(J+1:LTEXT-1)
1048            end if
1049         end if
1050      end if
1051  250 NTYP = NTYP + 1
1052      if (NTYP .le. 4) go to 220
1053  260 if (K .eq. 9) then
1054c         Just processed formats for option 15
1055         if (NOTOUT) then
1056            NOTOUT = .false.
1057C%%         fwrite(&iaopt, sizeof(iaopt), (size_t)1, iotemp);
1058            write (IOTEMP) IAOPT
1059         end if
1060C%%      fwrite(&dplotb.lentxt[8][0], sizeof(dplotb.lentxt[8][0]),
1061C%%          (size_t)2, iotemp);
1062C%%      fwrite(&dplotc.pos[60], (size_t)1, (size_t)4, iotemp);
1063         write (IOTEMP) LENTXT(1, 9), LENTXT(2, 9), POS(33:36)
1064C++ CODE for ~.C. is active
1065         if (IP(LDEBUG).gt.1) print 40, DB, IOTEMP, IAOPT,
1066     1       (LENTXT(K, 9), K = 1, 3), POS(33:36)
1067C++ CODE for .C. is inactive
1068C%%      if (dplotb.ip[LDEBUG-1] > 1) printf (fmt40,iaopt,
1069C%%        dplotb.lentxt[8][0], dplotb.lentxt[8][1],dplotb.lentxt[8][2],
1070C%%        &dplotc.pos[32]);
1071C++ END
1072         if (LENTXT(1,9).gt.0) then
1073C%%        fwrite(dplotc.fmtnum[8], (size_t)1,
1074C%%           (size_t)dplotb.lentxt[8][0], iotemp);
1075           write (IOTEMP) FMTNUM(9)(1:LENTXT(1,9))
1076C++ CODE for .C. is inactive
1077C%%        if (dplotb.ip[LDEBUG-1] > 1) printf (fmt20, iaopt,
1078C%%           (int)dplotb.lentxt[8][0], dplotc.fmtnum[8]);
1079C++ CODE for ~.C. is active
1080           if (IP(LDEBUG).gt.1)
1081     1       print 20, DB, IOTEMP, IAOPT,FMTNUM(9)(1:LENTXT(1,9))
1082C++ END
1083         end if
1084         if (LENTXT(3,9).gt.0) then
1085C%%        fwrite(dplotc.txtdef[8], (size_t)1,
1086C%%           (size_t)dplotb.lentxt[8][2], iotemp);
1087           write (IOTEMP) TXTDEF(9)(1:LENTXT(3,9))
1088C++ CODE for .C. is inactive
1089C%%        if (dplotb.ip[LDEBUG-1] > 1) printf (fmt30, iaopt,
1090C%%           (int)(dplotb.lentxt[8][2]), dplotc.txtdef[8]);
1091C++ CODE for ~.C. is active
1092           if (IP(LDEBUG).gt.1)
1093     1       print 30, DB, IOTEMP, IAOPT,TXTDEF(9)(1:LENTXT(3,9))
1094C++ END
1095         end if
1096         go to 400
1097      end if
1098      if ((K1 .eq. 0) .or. (K1 .eq. -1)) then
1099c                  Copy stuff for first border to all of them
1100         I = 10 + 9*K1
1101         L1 = LENTXT(1,I)
1102         L3 = LENTXT(3,I)
1103         do 280 J = I+1, I+5
1104            do 270 L = 1, 3
1105               LENTXT(L, J) = LENTXT(L, I)
1106  270       continue
1107C%%  if (l1>0) memcpy(dplotc.fmtnum[j-1],dplotc.fmtnum[i-1],(size_t)l1);
1108            if (L1 .gt. 0) FMTNUM(J)(1:L1)=FMTNUM(I)(1:L1)
1109C%%  if (l3>0) memcpy(dplotc.txtdef[j-1],dplotc.txtdef[i-1],(size_t)l3);
1110            if (L3 .gt. 0) TXTDEF(J)(1:L3)=TXTDEF(I)(1:L3)
1111  280    continue
1112      end if
1113      go to 200
1114c         Reduce count by 1 if not a "Q", then save next text pointer.
1115  290 if (K .ne. 1) LTEXT = LTEXT - 1
1116
1117c
1118c ******************** Process the options in OPT **********************
1119c
1120      IOP = 1
1121c              IOP(1) reserved for exit flag.
1122  300 IOP = IOP + 1
1123      IOP1 = IOP
1124      IOPT = nint(OPT(IOP))
1125C++ CODE for ~.C. is active
1126      if (IP(LDEBUG).gt.1) print '('' Option: OPT('', I3,'') ='', I3)',
1127     1    IOP, IOPT
1128C++ CODE for .C. is inactive
1129C%%   if (dplotb.ip[LDEBUG-1] > 1) printf (" Option: OPT(%li) = %li\n",
1130C%%      iop, iopt );
1131C++ END
1132      if (IOPT .eq. 0) go to 700
1133c
1134      IAOPT = abs(IOPT)
1135      if (IAOPT .gt. 28) go to 520
1136c                             Unpack associated data
1137      LOCI = 0
1138      LOCF = 0
1139      do 340 J = IRULE(IAOPT), IRULE(IAOPT+1) - 1
1140         L = LRULE(J)
1141         if (L .lt. 0) then
1142c                                Pick up -L floating point numbers
1143  320       IOP = IOP + 1
1144            LOCF = LOCF + 1
1145            FPIN(LOCF) = OPT(IOP)
1146            L = L + 1
1147            if (L .ne. 0) go to 320
1148         else
1149c                                Pick up and unpack an integer.
1150            IOP = IOP + 1
1151            TP = abs(OPT(IOP))
1152            M = nint(TP)
1153            if (abs(TP - dble(M)) .gt. .2D0) then
1154c                               Error -- Number specified not an integer
1155               IERR = 21
1156               go to 1430
1157            end if
1158c                   TP used in later test to see if too big.
1159            TP = M + 1
1160  330       LOCI = LOCI + 1
1161            if (NRULE(L) .ne. 0) then
1162               ININ(LOCI) = mod(M, NRULE(L))
1163               M = M / NRULE(L)
1164               L = L + 1
1165               go to 330
1166            else
1167c                         Last one takes the whole integer
1168               ININ(LOCI) = M
1169               if (TP - nint(abs(OPT(IOP))) .ne. 1.D0) then
1170c                           Error -- Floating number too big for integer
1171                  IERR = 22
1172                  go to 1430
1173               end if
1174            end if
1175         end if
1176  340 continue
1177c                            IOPT < 0, means don't process the option.
1178      if (IOPT .lt. 0) go to 300
1179c                            Option unpacked, now process.
1180      IACT = LINACT(IAOPT) - 1
1181      NOTOUT = .true.
1182      LOCI = 1
1183      LOCF = 1
1184  400 IACT = IACT + 1
1185      if (IACT .ge. LINACT(IAOPT+1)) go to 300
1186c              1    2    3    4    5    6    7    8    9   10   11
1187c         12   13   14   15   16   17   18
1188      go to (410, 420, 430, 430, 450, 460, 470, 480, 490, 500, 510,
1189     1   520, 520, 540, 550, 560, 520, 400), INACT(IACT)
1190c =1, Units / Final flag, and linex as x,y = 0, for option 1
1191  410 IP(NEXT) = ININ(1)
1192      if (IP(NEXT) .gt. 5) then
1193c                          Error -- Digit 10^0 of option 1 is too big
1194         IERR = 23
1195         go to 1430
1196      end if
1197      if (ININ(6) .gt. 1) then
1198c                         Error -- Type flag must be 0 or 1.
1199         IERR = 24
1200         go to 1430
1201      end if
1202      ININ(8) = ININ(6)
1203      if ((ININ(3) .ge. 4) .or. (ININ(4) .ge. 4)) then
1204c                        Polar coordinates or an error.
1205c          An error now since polar code is not yet written.
1206          IERR = 25
1207          go to 1430
1208      end if
1209      do 415 J = 1, 2
1210c                   Set flags for how the borders/axes are labeled.
1211         K = ININ(2+J)
1212         ININ(5+J) = mod(K, 2)
1213         if (K .eq. 3) ININ(2+J) = 2
1214  415 continue
1215      go to 400
1216c =2  Save border characteristics.  Option 4
1217  420 K = ININ(1)
1218  422 J = mod(K, 10)
1219      if ((J .ne. 0) .and. (J .le. 6)) then
1220         do 425 I = 1, 6
1221         MBORD(I, J) = ININ(I+1)
1222  425    continue
1223         if (ININ(8) .ne. 0) MBORD(7, J) = ININ(8)
1224      else
1225c         Error -- Only digits 1 to 6 can be used for borders.
1226         IERR = 26
1227         go to 1430
1228      end if
1229      K = K / 10
1230      if (K .ne. 0) go to 422
1231      go to 300
1232c =3,4  Tick info. for various borders. Options 5 and 6
1233  430 I1 = 2 * IAOPT - 9
1234      I = ININ(1)
1235  436 J = mod(I, 10)
1236      if ((J .ne. 0) .and. (J .le. 6)) then
1237      TICKS(I1, J) = FPIN(1)
1238      TICKS(I1+1, J) = FPIN(2)
1239      else
1240c         Error -- Only digits 1 to 6 can be used for borders.
1241         IERR = 26
1242         go to 1430
1243      end if
1244      I = I / 10
1245      if (I .ne. 0) go to 436
1246      go to 300
1247
1248c =5  Set ?MAX / ?MIN for current set. Options 8 and 9
1249  450 if (FPIN(1) .lt. FPIN(2)) then
1250         K = IAOPT - 7
1251         if (XYMIN(K) .lt. XYMAX(K)) then
1252c             Error -- min/max on x or y specified twice.
1253            IERR = 27
1254            go to 1430
1255         end if
1256         XYMIN(K) = FPIN(1)
1257         XYMAX(K) = FPIN(2)
1258      end if
1259      go to 300
1260
1261c =6  Check NY. Option 2
1262  460 if (IP(LNY) .ne. ININ(2)) then
1263         if (LAST .eq. 5) then
1264c                         Error -- NY changed in middle of curve
1265            IERR = 28
1266            go to 1430
1267         end if
1268      end if
1269      go to 400
1270c =7  Change in data set, Option 7
1271  470 I = ININ(1)
1272      IAX = 2 - mod(I, 2)
1273      if (I .le. 4) then
1274         if (NXYLIM(IAX) .eq. 0) then
1275c         Error -- Attempting to change data set without providing data.
1276            IERR = 29
1277            go to 1430
1278         end if
1279c                        Take care of border being replaced
1280         call DPLOTA(I)
1281         if (IOP1 .le. -100) go to 1500
1282c                        Save data for data set being replaced
1283         LSET = LSET + 1
1284         NXYLIM(LSET) = NXYLIM(IAX)
1285         XYLIM(1, LSET) = XYLIM(1, IAX)
1286         XYLIM(2, LSET) = XYLIM(2, IAX)
1287         XYBASE(LSET) = XYBASE(IAX)
1288         XYU2PF(LSET) = XYU2PF(IAX)
1289         KLIP(LSET) = KLIP(IAX)
1290c                        Set up for new data set.
1291         NXYLIM(IAX) = 0
1292         XYU2PF(IAX) = 0.D0
1293         XYMIN(IAX) = 0.D0
1294         XYMAX(IAX) = 0.D0
1295         MBORD(8, I) = IAX
1296         do 475 I = 1, 7
1297         MBORD(I, IAX) = ININ(I+2)
1298  475    continue
1299      end if
1300      PHYUSE(1, IAX) = FPIN(1)
1301      PHYUSE(2, IAX) = FPIN(2)
1302      go to 300
1303
1304c =8  Set defaults for widths on out of range values.
1305  480 FPIN(LWIDTH+1) = mod(FPIN(LWIDTH+1)/10.D0, 100.D0) / 10.D0
1306      FPIN(LWIDTH+2) = mod(FPIN(LWIDTH+2)/10.D0, 100.D0) / 10.D0
1307      do 485 I = 1, 5
1308         if (FPIN(I) .le. 0.D0) then
1309            FPIN(I) = FPDAT(LWIDTH-1+I)
1310         end if
1311  485 continue
1312      go to 400
1313c =9  Special symbol plotting (may be more than 1 N10)
1314  490 IOP = IOP + 1
1315      I = IOP
1316  495 if (OPT(IOP) .lt. 0) then
1317         IOP = IOP + 1
1318         go to 495
1319      end if
1320      J = IOP
1321      if (J - I .ge. IP(LNY)) then
1322c                              Error -- More symbols than allowed
1323         IERR = 30
1324         go to 1430
1325      end if
1326C%%   fwrite(&iaopt, sizeof(iaopt), (size_t)1, iotemp);
1327      write (IOTEMP) IAOPT
1328C%%   ictmp = j - i + 1;
1329C%%   fwrite(&ictmp, sizeof(ictmp), (size_t)1, iotemp);
1330C%%   for (k = i; k <= j; k++){
1331C%%   ictmp = abs(nint(opt[k-1]));
1332C%%   fwrite(&ictmp, sizeof(ictmp), (size_t)1, iotemp);}
1333      write (IOTEMP) J - I + 1, (nint(abs(OPT(K))), K = I, J)
1334C++ CODE for .C. is inactive
1335C%%   if (dplotb.ip[LDEBUG-1] > 1) {
1336C%%     printf (fmt50, iaopt);
1337C%%     for (k = i; k <= j; k++){
1338C%%        printf(fmt55, (long)abs(nint(opt[k-1])));}
1339c%%     printf ("\n");}
1340C++ CODE for ~.C. is active
1341      if (IP(LDEBUG).gt.1)
1342     1  print 50, DB, IOTEMP, IAOPT, (nint(abs(OPT(K))), K = I,J)
1343C++ END
1344      go to 300
1345
1346c =10  Single symbol (may require extra args.)
1347  500 J = 1
1348      K = abs(nint(OPT(IOP+1)))
1349      if (mod(K, 10) .eq. 1) then
1350         J = mod(K/10, 10) + 3
1351         if (J .ge. 5)  then
1352            if (J .gt. 5) then
1353c                          Error -- Bad value for symbol plotting
1354               IERR = 31
1355               go to 1430
1356            end if
1357            J = 3
1358         end if
1359      end if
1360      if (NOTOUT) then
1361         NOTOUT = .false.
1362C%%      fwrite(&iaopt, sizeof(iaopt), (size_t)1, iotemp);
1363         write (IOTEMP) IAOPT
1364      end if
1365C++ CODE for ~.C. is active
1366      write (IOTEMP) J, FPIN(1), FPIN(2), nint(OPT(IOP+1)),
1367     1   (OPT(I),I=IOP+2,IOP+J)
1368      if (IP(LDEBUG).gt.1) print 60, DB, IOTEMP, IAOPT, FPIN(1),
1369     1    FPIN(2), nint(OPT(IOP+1)), (OPT(I),I=IOP+2,IOP+J)
1370C++ CODE for .C. is inactive
1371C%%   fwrite(&j, sizeof(j), (size_t)1, iotemp);
1372C%%   fwrite(fpin, sizeof(fpin[0]), (size_t)2, iotemp);
1373C%%   ictmp = nint(opt[iop]);
1374C%%   fwrite(&ictmp, sizeof(ictmp), (size_t)1, iotemp);
1375C%%   fwrite(&opt[iop+1], sizeof(opt[0]), (size_t)(j-1), iotemp);
1376C%%   if (dplotb.ip[LDEBUG-1] > 1){
1377C%%     printf (fmt60, iaopt, fpin[0], fpin[1], nint(opt[iop]));
1378C%%     for (k=iop+2; k<=iop+j; k++) printf(fmt65,opt[k-1]);
1379c%%     printf ("\n");}
1380C++ END
1381      IOP = IOP + J
1382      go to 300
1383
1384c =11  For filling (may have up to 3 for each curve type) (scratch)
1385  510 J = 0
1386      if (ININ(1) .gt. 2) J = ININ(1) - 1
1387      if (J .gt. 3) then
1388c                   Error -- Digit 10^0 for option 19, must be < 5
1389      IERR = 32
1390      go to 1430
1391      end if
1392      if (NOTOUT) then
1393         NOTOUT = .false.
1394C%%      fwrite(&iaopt, sizeof(iaopt), (size_t)1, iotemp);
1395         write (IOTEMP) IAOPT
1396      end if
1397C++ CODE for ~.C. is active
1398      write (IOTEMP) J,ININ(1),ININ(2),ININ(3), (OPT(I),I=IOP+1,IOP+J)
1399      if (IP(LDEBUG).gt.1) print 70,
1400     1  IOTEMP, IAOPT, ININ(1),ININ(2),ININ(3), (OPT(I),I=IOP+1,IOP+J)
1401C++ CODE for .C. is inactive
1402C%%   fwrite(&j, sizeof(j), (size_t)1, iotemp);
1403C%%   fwrite(&inin[0], sizeof(inin[0]), (size_t)3, iotemp);
1404C%%   fwrite(&opt[iop], sizeof(opt[iop]), (size_t)j, iotemp);
1405C%%   if (dplotb.ip[LDEBUG-1] > 1) {
1406C%%      printf(fmt70, iaopt, inin[0], inin[1], inin[2]);
1407C%%      for (i = iop; i < iop+j; i++) printf(fmt65, opt[i]);
1408c%%      printf ("\n");}
1409C++ END
1410      IOP = IOP + J
1411      go to 300
1412c =? Invalid option (or maybe a bug in this code?)
1413  520 IERR = 20
1414      go to 1430
1415
1416c =14  There follows in INACT, n, w, p, where
1417c     n = number of integers
1418c     w = defines where they go when processing options: 1 storage,
1419c         2 scratch, 3 both  (NOT USED???)
1420c     p = gives index in IP() where integers start.
1421  540 if (INACT(IACT+2) .ge. 2) then
1422         if (NOTOUT) then
1423            NOTOUT = .false.
1424C%%         fwrite(&iaopt, sizeof(iaopt), (size_t)1, iotemp);
1425            write (IOTEMP) IAOPT
1426         end if
1427C++ CODE for ~.C. is active
1428         write(IOTEMP) (ININ(I), I=LOCI,LOCI+INACT(IACT+1)-1)
1429         if (IP(LDEBUG).gt.1) print 80, DB, IOTEMP, IAOPT,(ININ(I),
1430     1      I=LOCI,LOCI+INACT(IACT+1)-1)
1431C++ CODE for .C. is inactive
1432C%%      fwrite(&inin[loci-1], sizeof(inin[0]), (size_t)inact[iact],
1433C%%         iotemp);
1434C%%      if (dplotb.ip[LDEBUG-1] > 1) {
1435C%%         printf(fmt80, iaopt);
1436C%%         for (i = loci-1; i < loci+inact[iact]-2; i++)
1437C%%            printf(fmt85, inin[i]);
1438c%%         printf ("\n");}
1439C++ END
1440      end if
1441      if (INACT(IACT+2) .ne. 2) then
1442         do 545 I = INACT(IACT+3), INACT(IACT+3) + INACT(IACT+1) - 1
1443         IP(I) = ININ(LOCI)
1444         LOCI = LOCI + 1
1445  545    continue
1446      else
1447         LOCI = LOCI + INACT(IACT+1)
1448      end if
1449      IACT = IACT + 3
1450      go to 400
1451
1452c =15  As for 14, except for floating point data in FPIN().
1453  550 if (INACT(IACT+2) .ge. 2) then
1454         if (NOTOUT) then
1455            NOTOUT = .false.
1456C%%         fwrite(&iaopt, sizeof(iaopt), (size_t)1, iotemp);
1457            write (IOTEMP) IAOPT
1458         end if
1459C++ CODE for ~.C. is active
1460         write(IOTEMP) (FPIN(I), I=LOCF,LOCF+INACT(IACT+1)-1)
1461         if (IP(LDEBUG).gt.1) print 90, DB, IOTEMP, IAOPT,(FPIN(I),
1462     1      I=LOCF,LOCF+INACT(IACT+1)-1)
1463C++ CODE for .C. is inactive
1464C%%    fwrite(&fpin[locf-1],sizeof(fpin[0]),(size_t)inact[iact],iotemp);
1465C%%    if (dplotb.ip[LDEBUG-1] > 1) {
1466C%%       printf(fmt90, iaopt);
1467C%%       for (i = locf-1; i < locf+inact[iact]-2; i++)
1468C%%          printf(fmt95, fpin[i]);
1469c%%       printf ("\n");}
1470C++ END
1471      end if
1472      if (INACT(IACT+2) .ne. 2) then
1473      do 555 I = INACT(IACT+3), INACT(IACT+3) + INACT(IACT+1) - 1
1474      FP(I) = FPIN(LOCF)
1475      LOCF = LOCF + 1
1476  555 continue
1477      else
1478      LOCF = LOCF + INACT(IACT+1)
1479      end if
1480      IACT = IACT + 3
1481      go to 400
1482
1483c =16  Processing for text pointer.  In all cases here, the text is
1484c      acted upon immediately when read from the scratch file.
1485c      There follows in INACT, k
1486c        k =  9 For option 15, Sets format for next numeric output.
1487c        k = 16 Text output for options 14 and 16.
1488  560 IACT = IACT + 1
1489      K = INACT(IACT)
1490      I = ININ(LOCI-1)
1491      if (I .ne. 0) then
1492         LTEXT = I - 1
1493      else if (IOPT .ne. 14) then
1494c                  If not option 14, just flag that there is no text.
1495C%%      ictmp = -1;
1496C%%      fwrite(&ictmp, sizeof(ictmp), (size_t)1, iotemp);
1497C%%      ictmp = 0;
1498C%%      fwrite(&ictmp, sizeof(ictmp), (size_t)1, iotemp);
1499C%%      fwrite("  ..", (size_t)1, (size_t)4, iotemp);
1500         write (IOTEMP) -1, 0, '  ..'
1501C%%      if (dplotb.ip[LDEBUG-1] > 1)
1502C%%          printf (fmt10, iaopt, (long)0, "  ..");
1503         if (IP(LDEBUG).gt.1) print 10, DB, IOTEMP, IAOPT, 0, '  ..'
1504         go to 400
1505      end if
1506      POS(61:64) = '  ..'
1507      go to 210
1508c
1509c ***********  Done processing options, take care of X, Y, data ********
1510c
1511  700 IOP1 = -1
1512      I1 = 1
1513c        I1 is count of data to get when getting it from (X, Y).
1514      NY = IP(LNY)
1515      NDIMY = IP(LYDIM)
1516      do 705 K = 1, 2
1517         SETLIM(1,K) = XYMIN(K)
1518         SETLIM(2,K) = XYMAX(K)
1519c                               Take logs of limmits if necessary.
1520         if (XYMIN(K) .lt. XYMAX(K)) then
1521            if (IP(LCOOX) .eq. 2) then
1522               SETLIM(1, K) = log10(XYMIN(K))
1523               SETLIM(2, K) = log10(XYMAX(K))
1524            end if
1525         end if
1526  705 continue
1527      if (NXI .eq. 0) go to 780
1528C%%   ictmp = 30;
1529C%%   fwrite(&ictmp, sizeof(ictmp), (size_t)1, iotemp);
1530      write (IOTEMP) 30
1531C%%   fwrite(&lcurve, sizeof(lcurve), (size_t)1, iotemp);
1532C%%   fwrite(dplotb.jset, sizeof(dplotb.jset[0]), (size_t)2, iotemp);
1533C%%   fwrite(&ny, sizeof(ny), (size_t)1, iotemp);
1534      write (IOTEMP) LCURVE, JSET(1), JSET(2), NY
1535C++ CODE for .C. is inactive
1536C%%   if (dplotb.ip[LDEBUG-1]>1) printf(fmt130, lcurve, dplotb.jset[0],
1537C%%      dplotb.jset[1], (long)0, (long)0, ny);
1538C++ CODE for ~.C. is active
1539      if (IP(LDEBUG).gt.1)
1540     1  print 130, DB, IOTEMP, LCURVE,JSET(1),JSET(2),0,0,NY
1541C++ END
1542c              Get min/max value and write data
1543  710 continue
1544c%%   if (inunit != NULL) {
1545      if (INUNIT .gt. 0) then
1546c                             Get data off a file.
1547C%%      if (!fread(fpin, sizeof(fpin[0]), (size_t)(ny+1), inunit))
1548C%%        goto L_770;}
1549         read(INUNIT, *, END=770) FPIN(1), (FPIN(I+1), I = 1, NY)
1550C%%   else{
1551      else
1552         FPIN(1) = X(I1)
1553         do 720 I = 0, NY-1
1554            FPIN(I+2) = Y(NDIMY * I + I1)
1555  720    continue
1556C%%   };
1557      end if
1558c Check for bad data value now to avoid confusion when taking logs.
1559      if (FP(LBAD) .ge. 0.D0) then
1560c                Check for and flag bad output points.
1561         ININ(1) = 0
1562         do 730 I = 1, NY
1563            ININ(I+1) = 0
1564            if (FPIN(I+1) .eq. FP(LBAD+1)) ININ(I+1) = 1
1565  730    continue
1566         if (ININ(1).ne.0) then
1567C%%         ictmp = 30;
1568C%%         fwrite(&ictmp, sizeof(ictmp), (size_t)1, iotemp);
1569C%%         fwrite(inin, sizeof(inin[0]), (size_t)(ny+1), iotemp);
1570            write (IOTEMP) 32, (dble(ININ(I)), I=1,NY+1)
1571         end if
1572C++ CODE for .C. is inactive
1573C%%   if (dplotb.ip[LDEBUG-1] > 1) {
1574C%%     printf(fmt120, (long)31);
1575C%%     for (i = 0; i <= ny; i++) printf(fmt125, (double) inin[i]);
1576C%%     printf ("\n");}
1577C++ CODE for ~.C. is active
1578         if (IP(LDEBUG).gt.1)
1579     1     print 120, DB, IOTEMP,  32, (dble(ININ(I)), I=1,NY+1)
1580C++ END
1581      end if
1582c                           Check if want logs
1583      if (IP(LCOOX) .eq. 2) FPIN(1) = log10(FPIN(1))
1584      if (IP(LCOOY) .eq. 2) then
1585         do 740 I = 1, NY
1586            FPIN(I+1) = log10(FPIN(I+1))
1587  740    continue
1588      end if
1589c         Establish initial minimum/maximum values
1590      TP1 = FPIN(2)
1591      TP2 = TP1
1592c
1593      do 750 I = 2, NY
1594         TP1 = min(TP1, FPIN(I+1))
1595         TP2 = max(TP2, FPIN(I+1))
1596  750 continue
1597      if (NXYLIM(1) .eq. 0) then
1598         XYLIM(1,1) = FPIN(1)
1599         XYLIM(2,1) = FPIN(1)
1600         XYLIM(1,2) = TP1
1601         XYLIM(2,2) = TP2
1602         NXYLIM(1) = JSET(1)
1603         NXYLIM(2) = JSET(2)
1604      else
1605         XYLIM(1,1) = min(XYLIM(1,1), FPIN(1))
1606         XYLIM(2,1) = max(XYLIM(2,1), FPIN(1))
1607         XYLIM(1,2) = min(XYLIM(1,2), TP1)
1608         XYLIM(2,2) = max(XYLIM(2,2), TP2)
1609      end if
1610C%%   ictmp = 31;
1611C%%   fwrite(&ictmp, sizeof(ictmp), (size_t)1, iotemp);
1612C%%   fwrite(fpin, sizeof(fpin[0]), (size_t)(ny+1), iotemp);
1613      write (IOTEMP) 31, (FPIN(I), I= 1, NY+1)
1614C++ CODE for .C. is inactive
1615C%%   if (dplotb.ip[LDEBUG-1] > 1) {
1616C%%     printf(fmt120, (long)31);
1617C%%     for (i = 0; i <= ny;i++) printf(fmt125, fpin[i]);
1618C%%     printf ("\n");}
1619C++ CODE for ~.C. is active
1620      if (IP(LDEBUG).gt.1)
1621     1  print 120, DB, IOTEMP, 31, (FPIN(I), I=1,NY+1)
1622C++ END
1623      I1 = I1 + 1
1624      if (I1 .le. NXI) go to 710
1625c                     Data now written, if any -- Write end mark
1626 770  continue
1627c%%   if (inunit != NULL) {
1628      if (INUNIT .gt. 0) then
1629        NXI = I1
1630C%%     fclose(inunit);
1631        close(INUNIT)
1632C%%   }
1633      end if
1634
1635      if (IP(NEXT) .lt. 5) LCURVE = LCURVE + 1
1636  780 LAST = IP(NEXT)
1637      FPIN(1) = LAST
1638C%%   ictmp = 33;
1639C%%   fwrite(&ictmp, sizeof(ictmp), (size_t)1, iotemp);
1640C%%   fwrite(fpin, sizeof(fpin[0]), (size_t)(ny+1), iotemp);
1641      write (IOTEMP) 33, (FPIN(I), I = 1, NY+1)
1642C++ CODE for ~.C. is active
1643      if (IP(LDEBUG).gt.1)
1644     1  print 120, DB, IOTEMP, 33, (FPIN(I), I=1,NY+1)
1645      if (IP(LDEBUG).gt.1) print
1646     1 '(''**************** End of Inputs *************  LAST ='',I1)',
1647     2 LAST
1648C++ CODE for .C. is inactive
1649C%%   if (dplotb.ip[LDEBUG-1] > 1) {
1650C%%     printf(fmt120, (long)33);
1651C%%     for (i = 0; i <= ny; i++) printf(fmt125, fpin[i]);
1652C%%     printf ("\n");}
1653C%%   if (dplotb.ip[LDEBUG-1] > 1) printf(
1654C%% "**************** End of Inputs *************  LAST = %li\n",last);
1655C++ END
1656      if (LAST .gt. 2) then
1657         if (IOP1 .le. -100) go to 1510
1658         if (LAST .eq. 3) IOSTA = 1
1659         return
1660      end if
1661      TOPTS = TPTSET(LAST+1)
1662c
1663      if (IOSTA .gt. 0) then
1664C++ CODE for ~.C. is active
1665         IOTMP1 = IOTEMP
1666         DB = 'B'
1667         call DPLOTU (IOTMP2, ' ')
1668         if (IOP1 .le. -100) go to 1500
1669         rewind(IOTEMP)
1670C++ CODE for .C. is inactive
1671C%%      iotmp1 = iotemp;
1672C%%      iotmp2 = tmpfile();
1673C%%      if (iotmp2 == NULL) goto L_1500;
1674C%%      rewind(iotemp);
1675C++ END
1676         if (IP(LDEBUG) .gt. 1) print '(''Rewind IOTEMP'')'
1677      end if
1678c
1679c *********************** Start Processing Saved Data ******************
1680c
1681c  Take care of axes, get max's and min's, draw lines a x=0, y=0, etc.
1682  800 do 820 I = 1, 6
1683         call DPLOTA(I)
1684  820 continue
1685C++ CODE for ~.C. is active
1686      DB = 'R'
1687C++ END
1688      if (IOP1 .le. -100) go to 1500
1689      NOOUT = .false.
1690  830 KX = 1
1691      KY = 1
1692c                  Set "17" (file name) as already output.
1693      LENTXT(1, 17) = -1
1694      LENTXT(3, 17) = -1
1695c
1696      IY = 1
1697      KSYMB = -1
1698      MODE = 0
1699  840 NMODE = 10
1700c                     Points are connected, take care of them.
1701  860 MOREIY = .false.
1702      IP(INTERP) = 0
1703
1704      if (IOSTA .le. 0) then
1705        if (IP(LDEBUG) .gt. 1) print '(''Rewind IOTEMP'')'
1706C%%     rewind(iotemp);
1707        rewind(IOTEMP)
1708      end if
1709  890 continue
1710C%%   fread(&iaopt, sizeof(iaopt), (size_t)1, iotemp);
1711      read (IOTEMP) IAOPT
1712      if (IOSTA .ne. 0) then
1713         if (IOSTA .gt. 0) then
1714C%%         fwrite(&iaopt, sizeof(iaopt), (size_t)1, iotmp2);
1715            write (IOTMP2) IAOPT
1716         else if (IAOPT .ge. 30) then
1717            if (IAOPT .eq. 33) go to 1300
1718            if (IY .le. 1) go to 890
1719         end if
1720      end if
1721      IACT = LINACT(IAOPT) - 1
1722      LOCI = 1
1723      LOCF = 1
1724  900 IACT = IACT + 1
1725      if (IACT .ge. LINACT(IAOPT+1)) go to 890
1726c              9  10  11  12  13  14  15  16  17  18  19   20   21   22
1727      go to (920,930,940,910,910,950,960,970,990,980,910,1000,1200,1300)
1728     1 , INACT(IACT) - 8
1729  910 go to 900
1730c
1731c Special Symbol plotting -- 9
1732  920 continue
1733C++ CODE for ~.C. is active
1734      read (IOTEMP) L, (ININ(I), I = 1, L)
1735      if (IOSTA .gt. 0) write (IOTMP2) L, (ININ(I), I = 1, L)
1736      if (IP(LDEBUG).gt.1)
1737     1  print 50, DB, IOTEMP, IAOPT, (ININ(I), I = 1, L)
1738C++ CODE for .C. is inactive
1739C%%   fread(&l, sizeof(l), (size_t)1, iotemp);
1740C%%   fread(inin, sizeof(inin[0]), (size_t)l, iotemp);
1741C%%   if (iosta > 0) {
1742C%%     fwrite(&l, sizeof(l), (size_t)1, iotmp2);
1743C%%     fwrite(inin, sizeof(inin[0]), (size_t)l, iotmp2);}
1744C%%   if (dplotb.ip[LDEBUG-1] > 1) {
1745C%%     printf (fmt50, iaopt);
1746C%%     for (i = 0; i < l; i++) printf(fmt55, inin[i]);
1747C%%     printf ("\n");}
1748C++ END
1749      KSYMB = abs(ININ(min(L, IY)))
1750      go to 900
1751c
1752c Single symbol to plot -- 10
1753  930 continue
1754C++ CODE for ~.C. is active
1755      read (IOTEMP) L, FPIN(1), FPIN(2), J, (FPIN(I-1), I = 4, L+2)
1756      if (IOSTA .gt. 0) write (IOTMP2) L, FPIN(1), FPIN(2), J,
1757     1  (FPIN(I-1), I = 4, L+2)
1758      if (IP(LDEBUG).gt.1) print 60, DB, IOTEMP, IAOPT, FPIN(1),
1759     1     FPIN(2), J, (FPIN(I-1), I = 4, L+2)
1760C++ CODE for .C. is inactive
1761C%%   fread(&l, sizeof(l), (size_t)1, iotemp);
1762C%%   fread(fpin, sizeof(fpin[0]), (size_t)2, iotemp);
1763C%%   fread(&j, sizeof(j), (size_t)1, iotemp);
1764C%%   fread(&fpin[2], sizeof(fpin[0]), (size_t)(l-1), iotemp);
1765C%%   if (iosta > 0) {
1766C%%      fwrite(&l, sizeof(l), (size_t)1, iotmp2);
1767C%%      fwrite(fpin, sizeof(fpin[0]), (size_t)2, iotmp2);
1768C%%      fwrite(&j, sizeof(j), (size_t)1, iotmp2);
1769C%%      fwrite(&fpin[2], sizeof(fpin[0]), (size_t)(l-1), iotmp2);}
1770C%%   if (dplotb.ip[LDEBUG-1] > 1){
1771C%%     printf (fmt60, iaopt, fpin[0], fpin[1], j);
1772C%%     for (i=2; i<=l+2; i++) printf(fmt65,fpin[i]);
1773c%%     printf ("\n");}
1774C++ END
1775      if (MODE .lt. 7) then
1776         NMODE = min(NMODE, 7)
1777      else
1778         KX = 1
1779         KY = 2
1780         call DPLOTR(FPIN, J, KX, KY)
1781      end if
1782      go to 900
1783c
1784c For Filling -- 11
1785  940 continue
1786C++ CODE for ~.C. is active
1787      read (IOTEMP) L,ININ(1),ININ(2),ININ(3),(FPIN(I),I=1, L)
1788      if (IOSTA .gt. 0) write (IOTMP2)  L, ININ(1), ININ(2),
1789     1   ININ(3), (FPIN(I), I=1, L)
1790      if (IP(LDEBUG).gt.1)
1791     1  print 70, DB, IOTEMP, IAOPT, ININ(1),ININ(2),ININ(3),
1792     2  (FPIN(I),I=1, L)
1793C++ CODE for .C. is inactive
1794C%%   fread(&l, sizeof(l), (size_t)1, iotemp);
1795C%%   fread(inin, sizeof(inin[0]), (size_t)3, iotemp);
1796C%%   fread(fpin, sizeof(fpin[0]), (size_t)l, iotemp);
1797C%%   if (iosta > 0) {
1798C%%      fwrite(&l, sizeof(l), (size_t)1, iotmp2);
1799C%%      fwrite(inin, sizeof(inin[0]), (size_t)3, iotmp2);
1800C%%      fwrite(fpin, sizeof(fpin[0]), (size_t)l, iotmp2);}
1801C%%   if (dplotb.ip[LDEBUG-1] > 1) {
1802C%%      printf(fmt70, iaopt, inin[0], inin[1], inin[2]);
1803C%%      for (i = iop; i < iop+l; i++) printf(fmt65, opt[i]);
1804c%%      printf ("\n");}
1805C++ END
1806      J = ININ(2)
1807      if (ININ(1) .eq. 0) then
1808         MFILL(J) = 0
1809      else
1810         MFILL(J) = min(MFILL(J)+1, 3)
1811         LFILL(MFILL(J), ININ(2)) = ININ(1)
1812         if (ININ(3) .gt. 0) MFILL(J) = -MFILL(J)
1813         if (L .gt. 0) then
1814            K = 1
1815            if (L .eq. 3) K = 7
1816            FILL(K) = FPIN(1)
1817            FILL(K+1) = FPIN(2)
1818            if (L .eq. 3) FILL(K+2) = FPIN(3)
1819         end if
1820      end if
1821      go to 900
1822c
1823c Integers to restore.
1824  950 if (INACT(IACT+2) .ne. 1) then
1825         L = INACT(IACT+1)
1826         J = INACT(IACT+3)
1827C++ CODE for ~.C. is active
1828         read(IOTEMP) (IP(J+I-1), I=1, L)
1829         if (IOSTA .gt. 0) write (IOTMP2)  (IP(J+I-1), I=1, L)
1830         if (IP(LDEBUG).gt.1)
1831     1     print 80, DB, IOTEMP, IAOPT, (IP(J+I-1), I=1, L)
1832C++ CODE for .C. is inactive
1833C%%      fread(&dplotb.ip[j], sizeof(dplotb.ip[0]), (size_t)l, iotemp);
1834C%%      if (iosta > 0) fwrite(dplotb.ip, sizeof(dplotb.ip[0]),
1835C%%         (size_t)l, iotmp2);
1836C%%      if (dplotb.ip[LDEBUG-1] > 1) {
1837C%%         printf(fmt80, iaopt);
1838C%%         for (i = j-1; i < j+l-2; i++) printf(fmt85, dplotb.ip[i]);
1839c%%         printf ("\n");}
1840C++ END
1841      end if
1842      IACT = IACT + 3
1843      if (IAOPT .eq. 1) then
1844         if (MODE .le. 5) then
1845            MODE = IP(INTERP)
1846C%%         if (dplotb.ip[LDEBUG-1]>1) printf("MODE set to %li", mode);
1847            if (IP(LDEBUG).gt.1) print '('' MODE set to'', I2)', MODE
1848         end if
1849      end if
1850      go to 900
1851c
1852c Floating point to restore
1853  960 if (INACT(IACT+2) .ne. 1) then
1854         L = INACT(IACT+1)
1855         J = INACT(IACT+3)
1856C++ CODE for ~.C. is active
1857         read(IOTEMP) (FP(J+I-1), I=1, L)
1858         if (IOSTA .gt. 0) write (IOTMP2)  (FP(J+I-1), I=1, L)
1859         if (IP(LDEBUG).gt.1)
1860     1     print 90, DB, IOTEMP, IAOPT, (FP(J+I-1), I=1, L)
1861C++ CODE for .C. is inactive
1862C%%      fread(&dplotb.fp[j-1], sizeof(dplotb.fp[0]),(size_t)l,iotemp);
1863C%%      if (iosta > 0) fwrite(&dplotb.fp[j-1], sizeof(dplotb.fp[0]),
1864C%%         (size_t)l, iotmp2);
1865C%%      if (dplotb.ip[LDEBUG-1] > 1) {
1866C%%       printf(fmt90, iaopt);
1867C%%       for (i = j-1; i < j+l-2; i++) printf(fmt95, dplotb.fp[i]);
1868c%%       printf ("\n");}
1869C++ END
1870      end if
1871      IACT = IACT + 3
1872      go to 900
1873c
1874c Text to restore
1875  970 IACT = IACT + 1
1876      K = INACT(IACT)
1877      if (K .ne. 9) then
1878C++ CODE for ~.C. is active
1879         read (IOTEMP) LENTXT(1,16), NTEXT, POS(61:64)
1880         if (IOSTA .gt. 0) write (IOTMP2)  LENTXT(1,16), NTEXT,
1881     1      POS(61:64)
1882         if (IP(LDEBUG).gt.1)
1883     1     print 10, DB, IOTEMP, IAOPT, LENTXT(1,16), POS(61:64)
1884C++ CODE for .C. is inactive
1885C%%      fread (&dplotb.lentxt[15][0], sizeof(dplotb.lentxt[0][0]),
1886C%%         (size_t)1, iotemp);
1887C%%      fread(&dplotb.ntext, sizeof(dplotb.ntext), (size_t)1, iotemp);
1888C%%      fread(&dplotc.pos[60], (size_t)1, (size_t)4, iotemp);
1889C%%      if (iosta > 0) {
1890C%%         fwrite(&dplotb.lentxt[15][0],
1891C%%             sizeof(dplotb.lentxt[0][0]),(size_t)1,iotmp2);
1892C%%         fwrite(&dplotb.ntext,sizeof(dplotb.ntext),(size_t)1,iotmp2);
1893C%%         fwrite(&dplotc.pos[60], (size_t)1, (size_t)4, iotmp2);}
1894C%%      if (dplotb.ip[LDEBUG-1] > 1) printf (fmt10, iaopt,
1895C%%         dplotb.lentxt[15][0], &dplotc.pos[60]);
1896C++ END
1897         if (LENTXT(1,16) .gt. 0) then
1898C++ CODE for ~.C. is active
1899            read (IOTEMP) FMTNUM(16)(1:LENTXT(1,16))
1900            if (IOSTA .gt. 0) write (IOTMP2) FMTNUM(16)(1:LENTXT(1,16))
1901            if (IP(LDEBUG).gt.1) print 20,
1902     1         IOTMP2, IAOPT,FMTNUM(16)(1:LENTXT(1,16))
1903C++ CODE for .C. is inactive
1904C%%         fread(dplotc.fmtnum[15], (size_t)1,
1905C%%            (size_t)dplotb.lentxt[15][0], iotemp);
1906c%%         if (iosta > 0) fwrite(dplotc.fmtnum[15], (size_t)1,
1907C%%            (size_t)dplotb.lentxt[15][0], iotemp);
1908C%%         if (dplotb.ip[LDEBUG-1] > 0) printf (fmt20, iaopt,
1909C%%            (int)dplotb.lentxt[15][0], dplotc.fmtnum[15]);
1910C++ END
1911         end if
1912         if (NTEXT .ne. 0) then
1913C++ CODE for ~.C. is active
1914            read (IOTEMP) TEXT(1:NTEXT)
1915            if (IOSTA .gt. 0) write (IOTMP2) TEXT(1:NTEXT)
1916            if (IP(LDEBUG).gt.1)
1917     1        print 30, DB, IOTEMP, IAOPT, TEXT(1:NTEXT)
1918C++ CODE for .C. is inactive
1919C%%         fread(dplotc.text, (size_t)1, (size_t)dplotb.ntext, iotemp);
1920C%%         if (iosta > 0) fwrite(dplotc.text, (size_t)1,
1921C%%            (size_t)dplotb.ntext, iotmp2);
1922C%%         if (dplotb.ip[LDEBUG-1] > 1) printf (fmt30, iaopt,
1923C%%            (int)(dplotb.ntext), dplotc.text);
1924C++ END
1925         end if
1926      else if (IAOPT .ne. 14) then
1927C++ CODE for ~.C. is active
1928         read(IOTEMP) LENTXT(1, 9), LENTXT(2, 9), POS(33:36)
1929         if (IOSTA .gt. 0) write (IOTMP2)  LENTXT(1, 9),
1930     1       LENTXT(2, 9), POS(33:36)
1931         if (IP(LDEBUG).gt.1) print 10, DB, IOTEMP, IAOPT, 0, '  ..'
1932C++ CODE for .C. is inactive
1933C%%      fread(&dplotb.lentxt[8][0], sizeof(dplotb.lentxt[8][0]),
1934C%%          (size_t)2, iotemp);
1935C%%      fread(&dplotc.pos[32], (size_t)1, (size_t)4, iotemp);
1936C%%      if (iosta > 0) {
1937C%%         fwrite(&dplotb.lentxt[8][0], sizeof(dplotb.lentxt[8][0]),
1938C%%            (size_t)2, iotmp2);
1939C%%         fwrite(&dplotc.pos[32], (size_t)1, (size_t)4, iotmp2);}
1940C%%      if (dplotb.ip[LDEBUG-1] > 1) printf (fmt10, iaopt,
1941c%%         (long)0, "  ..");
1942C++ END
1943      else
1944C++ CODE for ~.C. is active
1945         read (IOTEMP) (LENTXT(K, 9), K = 1, 3), POS(33:36)
1946         if (IOSTA .gt. 0) write (IOTMP2)
1947     1       (LENTXT(K, 9), K = 1, 3), POS(33:36)
1948         if (IP(LDEBUG).gt.1) print 40, DB, IOTEMP, IAOPT,
1949     1       (LENTXT(K, 9), K = 1, 3), POS(33:36)
1950C++ CODE for .C. is inactive
1951C%%      fread(&dplotb.lentxt[8][0], sizeof(dplotb.lentxt[8][0]),
1952C%%          (size_t)3, iotemp);
1953C%%      fread(&dplotc.pos[32], (size_t)1, (size_t)4, iotemp);
1954C%%      if (iosta > 0) {
1955C%%      fwrite(&dplotb.lentxt[8][0], sizeof(dplotb.lentxt[8][0]),
1956C%%          (size_t)3, iotmp2);
1957C%%      fwrite(&dplotc.pos[32], (size_t)1, (size_t)4, iotmp2);}
1958C%%      if (dplotb.ip[LDEBUG-1] > 1) printf (fmt40, iaopt,
1959C%%        dplotb.lentxt[8][0], dplotb.lentxt[8][1],dplotb.lentxt[8][2],
1960C%%        &dplotc.pos[32]);
1961C++ END
1962         if (LENTXT(1,9).gt.0) then
1963C++ CODE for ~.C. is active
1964           read (IOTEMP) FMTNUM(9)(1:LENTXT(1,9))
1965           if (IOSTA .gt. 0) write (IOTMP2)
1966     1         FMTNUM(9)(1:LENTXT(1,9))
1967           if (IP(LDEBUG).gt.1)
1968     1       print 20, DB, IOTEMP, IAOPT,FMTNUM(9)(1:LENTXT(1,9))
1969C++ CODE for .C. is inactive
1970C%%        fread(dplotc.fmtnum[8], (size_t)1,
1971C%%           (size_t)dplotb.lentxt[15][0], iotemp);
1972c%%        if (iosta > 0) fwrite(dplotc.fmtnum[8], (size_t)1,
1973C%%           (size_t)dplotb.lentxt[15][0], iotemp);
1974C%%        if (dplotb.ip[LDEBUG-1] > 0)  printf (fmt20, iaopt,
1975C%%           (int)dplotb.lentxt[15][0], dplotc.fmtnum[8]);
1976C++ END
1977         end if
1978         if (LENTXT(3,9).gt.0) then
1979C++ CODE for ~.C. is active
1980           read (IOTEMP) TXTDEF(9)(1:LENTXT(3,9))
1981           if (IOSTA .gt. 0) write (IOTMP2) TXTDEF(9)(1:LENTXT(3,9))
1982           if (IP(LDEBUG).gt.1)
1983     1       print 30, DB, IOTEMP, IAOPT,TXTDEF(9)(1:LENTXT(3,9))
1984C++ CODE for .C. is inactive
1985C%%        fread(dplotc.txtdef[8], (size_t)1,
1986C%%           (size_t)dplotb.lentxt[8][2], iotemp);
1987C%%        if (iosta > 0) fwrite(dplotc.txtdef[8], (size_t)1,
1988C%%           (size_t)dplotb.lentxt[8][2], iotmp2);
1989C%%        if (dplotb.ip[LDEBUG-1] > 1) printf (fmt30, iaopt,
1990C%%           (int)(dplotb.lentxt[8][2]), dplotc.txtdef[8]);
1991C++ END
1992         end if
1993      end if
1994      if (MODE .lt. 9) then
1995         NMODE = min(NMODE, 9)
1996      else if (MODE .eq. 9) then
1997c           Output the text
1998         if (IAOPT .ne. 16) then
1999            if ((NTEXT .eq. 0) .and. (IAOPT .eq. 14)) go to 900
2000            I = IP(LTANNO)
2001            OPAQUE = .false.
2002            if (I .gt. 3) then
2003c                      Want placed in an opaque box.
2004               OPAQUE = .true.
2005               I = I - 4
2006            end if
2007c   Set up for differences between output of numbers and text
2008            K1 = 4 * K
2009            L1 = 7
2010            if (K .eq. 9)  then
2011               L1 = 8
2012               FP(LVALS+3) = FP(LVALS)
2013               FP(LVALS) = FP(LVALS+1)
2014               FP(LVALS+1) = FP(LVALS+2)
2015            end if
2016            K2 = 4 * L1
2017C%%         if (memcmp(dplotc.pos+k1-4, "  ..", (size_t)4) == 0)
2018C%%             memcpy(dplotc.pos+k1-4, dplotc.pos+k2-4,(size_t)4);
2019            if (POS(K1-3:K1) .eq. '  ..') POS(K1-3:K1) = POS(K2-3:K2)
2020            if (I .ge. 2) then
2021c                         Set to avoid the formatting.
2022               I = I - 2
2023               K = 17
2024C%%            memcpy(dplotc.pos+64, dplotc.pos+k1-4,(size_t)4);
2025               POS(65:68) = POS(K1-3:K1)
2026            else
2027c                         Set up the formatting
2028               if (LENTXT(1, K) .lt. 0) then
2029                  LENTXT(1, K) = LENTXT(1, L1)
2030C++ CODE for .C. is inactive
2031C%%               if (dplotb.lentxt[l1 - 1][0] > 0)
2032C%%                  memcpy(dplotc.fmtnum[k-1],dplotc.fmtnum[l1-1],
2033C%%                  dplotb.lentxt[l1 - 1][0]);
2034C++ CODE for ~.C. is active
2035                  if (LENTXT(1,L1).gt. 0) FMTNUM(K)(1:LENTXT(1,K)) =
2036     1                FMTNUM(L1)(1:LENTXT(1, L1))
2037C++ END
2038               end if
2039               LENTXT(3, K) = LENTXT(3, L1)
2040               if (LENTXT(3, L1) .gt. 0) then
2041                   LENTXT(2, K) = LENTXT(2, L1)
2042C%%                memcpy(dplotc.txtdef[k-1],dplotc.txtdef[l1-1],
2043C%%                   dplotb.lentxt[l1-1][2]);
2044                   TXTDEF(K)(1:) = TXTDEF(L1)(1:LENTXT(3, L1))
2045               end if
2046            end if
2047            do 975 J = 0, 1
2048               if (IP(LCOOX+J) .eq. 2) then
2049                  FP(LVALS+J) = log10(FP(LVALS+J))
2050               end if
2051  975       continue
2052            if (I .eq. 0) then
2053c                      Convert to physical coordinates
2054              MANNO = -1
2055              XYPOS(1) = XYBASE(KX) + XYU2PF(KX) * FP(LVALS)
2056              XYPOS(2) = XYBASE(KY) + XYU2PF(KY) * FP(LVALS+1)
2057            else
2058              MANNO = 1
2059              XYPOS(1) = TOPTS * FP(LVALS)
2060              XYPOS(2) = TOPTS * FP(LVALS+1)
2061            end if
2062            if (L1 .eq. 7) then
2063               call DPLOTT(K, XYPOS)
2064            else
2065               call DPLOTN(FP(LVALS+3), K, XYPOS)
2066            end if
2067            MANNO = 0
2068         else
2069c      Text for Axis/Border Annotation -- Must be processed in DPLOTA.
2070            call DPLOTA(IP(LTANNO+1)+10)
2071            if (IOP1 .le. -100) go to 1500
2072         end if
2073      end if
2074      go to 900
2075c
2076c Rectangles ellipses and lines.
2077  980 if (MODE .lt. 8) then
2078         NMODE = min(NMODE, 8)
2079         go to 900
2080      end if
2081      if (IAOPT .le. 21) then
2082c            Convert to physical coordinates (only first two for ellipse
2083         XOUT(1) = XYBASE(KX) + XYU2PF(KX) * FP(LVALS)
2084         YOUT(1) = XYBASE(KY) + XYU2PF(KY) * FP(LVALS+1)
2085
2086         if (IAOPT .ne. 21) then
2087            XOUT(2) = XYBASE(KX) + XYU2PF(KX) * FP(LVALS+2)
2088            YOUT(2) = XYBASE(KY) + XYU2PF(KY) * FP(LVALS+3)
2089         end if
2090      else
2091c            Conver physical coordinates to points.
2092         IAOPT = IAOPT - 3
2093         XOUT(1) = TOPTS * FP(LVALS)
2094         YOUT(1) = TOPTS * FP(LVALS+1)
2095         XOUT(2) = TOPTS * FP(LVALS+2)
2096         YOUT(2) = TOPTS * FP(LVALS+3)
2097         if (IAOPT .eq. 21) then
2098            FP(LVALS+2) = XOUT(3)
2099            FP(LVALS+3) = XOUT(4)
2100         end if
2101      end if
2102      if ( IAOPT .eq. 19) then
2103c                  Draw a line
2104         KURPEN = IP(LPEN)
2105         call DPLOT2(XOUT(1), YOUT(1), XOUT(2), YOUT(2))
2106      else if (IAOPT .eq. 20) then
2107c                  Draw a rectangle
2108         KURPEN = FP(LWIDRE)
2109         if (MFILL(2) .ne. 0) call DPLOT7(MFILL(2), LFILL(1,2), FILL)
2110         call DPLOT5(XOUT(1), YOUT(1), XOUT(2), YOUT(2))
2111      else
2112c                  Draw an ellipse
2113         KURPEN = FP(LWIDRE)
2114         if (MFILL(3) .ne. 0) call DPLOT7(MFILL(3), LFILL(1,3), FILL)
2115         call DPLOT6(XOUT(1), YOUT(1), FP(LVALS+2), FP(LVALS+3),
2116     1      FP(LVALS+4))
2117      end if
2118      go to 900
2119c
2120c Raw MFPIC output
2121  990 continue
2122C%%   fread(&dplotb.ntext, sizeof(dplotb.ntext), (size_t)1, iotemp);
2123C%%   fread(dplotc.text, (size_t)1, (size_t)(dplotb.ntext), iotemp);
2124      read(IOTEMP) NTEXT, TEXT(1:NTEXT)
2125C%%   if (iosta > 0) {
2126C%%     fwrite(&dplotb.ntext, sizeof(dplotb.ntext), (size_t)1, iotemp);
2127C%%     fwrite(dplotc.text, (size_t)1, (size_t)(dplotb.ntext), iotemp);}
2128      if (IOSTA .gt. 0) write (IOTMP2) NTEXT, TEXT(1:NTEXT)
2129C%%   if (dplotb.ip[LDEBUG-1] > 1) printf (fmt30, iaopt,
2130C%%      (int)(dplotb.ntext), dplotc.text);
2131      if (IP(LDEBUG).gt.1) print 30, DB, IOTEMP, IAOPT, TEXT(1:NTEXT)
2132      if (MODE .lt. 9) then
2133         NMODE = min(NMODE, 9)
2134      else if (MODE .eq. 9) then
2135c                            Output the text
2136C%%      fprintf(iofil, "%.*s\n", (int)dplotb.ntext, dplotc.text);
2137         write (IOFIL, '(A)') TEXT(1:NTEXT)
2138      end if
2139      go to 900
2140c
2141c New data start
2142 1000 continue
2143C%%   fread(&i, sizeof(i), (size_t)1, iotemp);
2144C%%   fread(&j, sizeof(j), (size_t)1, iotemp);
2145C%%   fread(&k, sizeof(k), (size_t)1, iotemp);
2146C%%   fread(&ny, sizeof(ny), (size_t)1, iotemp);
2147      read (IOTEMP) I, J, K, NY
2148C++ CODE for .C. is inactive
2149C%%   if (dplotb.ip[LDEBUG-1] > 1) printf(fmt130,i, j, k, mode, iy, ny);
2150C++ CODE for ~.C. is active
2151      if (IP(LDEBUG) .gt. 1)
2152     1  print 130, DB, IOTEMP, I, J, K, MODE, IY, NY
2153c++ END
2154      if (IY .le. NY) then
2155         LY = IY
2156c                       Keep  track of last that needs to be done again.
2157         DATSAV = .false.
2158         if (IY .lt. NY) then
2159            MOREIY = .true.
2160            if (IOSTA .gt. 0) then
2161C%%   fwrite(&i, sizeof(i), (size_t)1, iotmp2);
2162C%%   fwrite(&j, sizeof(j), (size_t)1, iotmp2);
2163C%%   fwrite(&k, sizeof(k), (size_t)1, iotmp2);
2164C%%   fwrite(&ny, sizeof(ny), (size_t)1, iotmp2);
2165               write (IOTMP2) I, J, K, NY
2166               DATSAV = .true.
2167            end if
2168         end if
2169         if (MODE .le. 4) then
2170            if (KSYMB .ge. 0) then
2171               NMODE = 6
2172               KSYMB = -1
2173            end if
2174            go to 1020
2175         else if (MODE .le. 6) then
2176            if (KSYMB .ge. 0) then
2177c                        Adjust LY in some cases
2178               if (mod(KSYMB, 10) .eq. 1) then
2179                  LY = 3
2180                  if (mod(KSYMB/10, 10) .eq. 0) LY = 2
2181                  LY = 1 + LY * (IY - 1)
2182               end if
2183               if ((MODE .ne. 6) .or. (IP(INTERP) .lt. 5)) go to 1025
2184            else if (MODE .ne. 6) then
2185c                 Points have been provided, but they are not plotted.
2186                call DPLOTE(1, OPT, COPT)
2187            end if
2188         end if
2189      end if
2190c               Consume till get to the end of a data set.
2191 1010 continue
2192
2193C%%   fread(&iaopt, sizeof(iaopt), (size_t)1, iotemp);
2194C%%   fread(fpin, sizeof(fpin[0]), (size_t)(ny+1), iotemp);
2195      read (IOTEMP) IAOPT, (FPIN(J), J = 1, NY+1)
2196C++ CODE for .C. is inactive
2197C%%   if (dplotb.ip[LDEBUG-1] > 1) {
2198C%%     printf(fmt120, iaopt);
2199C%%     for (i = 0; i <= ny; i++) printf(fmt125, fpin[i]);
2200C%%     printf ("\n");}
2201C++ CODE for ~.C. is active
2202      if (IP(LDEBUG) .gt. 1)
2203     1  print 120, DB, IOTEMP, IAOPT,  (FPIN(J), J = 1,NY+1)
2204C++ END
2205      if (IAOPT .ne. 33) go to 1010
2206      go to 1170
2207c                  Get pen set
2208 1020 KURPEN = IP(LPEN)
2209      call DPLOT1
2210c                               Process the data
2211 1025 do 1030 I = 1, LSET
2212         if (NXYLIM(I) .eq. J) go to 1040
2213 1030 continue
2214C%%   puts( "Error -- Internal bug, couldn't find X index" );
2215C%%   close_units();
2216C%%   puts( "[Stop]" );
2217C%%   exit(0);
2218      stop 'Error -- Internal bug, couldn''t find X index'
2219 1040 KX = I
2220      do 1050 I = 1, LSET
2221         if (NXYLIM(I) .eq. K) go to 1070
2222 1050 continue
2223C%%   puts( "Error -- Internal bug, couldn't find Y index" );
2224C%%   close_units();
2225C%%   puts( "[Stop]" );
2226C%%   exit(0);
2227      stop 'Error -- Internal bug, couldn''t find Y index'
2228 1070 if (LAST .eq. 5) go to 1120
2229      KPT = 0
2230      KY = I
2231c Set up for type of curve, clipping, etc.
2232
2233 1080 BADPT = .false.
2234      LKLIP = .false.
2235      if (MODE .lt. 5) then
2236         call DPLOTL(-1-MODE, XOUT, YOUT)
2237         if (MODE .le. 2) then
2238c                         Initialize DPLOTF
2239            K = -1
2240            if (KLIP(KX) .or. KLIP(KY)) K = -3
2241            call DPLOTF(K, XOUT, XYLIM(1, KX), XYLIM(1, KY))
2242            if (IOP1 .le. -100) go to 1500
2243         end if
2244      end if
2245c
2246      if (IAOPT .eq. 31) go to 1180
2247 1120 continue
2248C++ CODE for ~.C. is active
2249      read (IOTEMP) IAOPT, (FPIN(J), J = 1, NY+1)
2250      if (DATSAV) write (IOTMP2) IAOPT, (FPIN(J), J = 1, NY+1)
2251      if (IP(LDEBUG) .gt. 1)
2252     1  print 120, DB, IOTEMP, IAOPT,  (FPIN(J), J = 1, NY+1)
2253C++ CODE for .C. is inactive
2254C%%   fread(&iaopt, sizeof(iaopt), (size_t)1, iotemp);
2255C%%   fread(fpin, sizeof(fpin[0]), (size_t)(ny+1), iotemp);
2256C%%   if (datsav) {
2257C%%     fwrite(&iaopt, sizeof(iaopt), (size_t)1, iotmp2);
2258C%%     fwrite(fpin, sizeof(fpin[0]), (size_t)(ny+1), iotmp2);}
2259C%%   if (dplotb.ip[LDEBUG-1] > 1) {
2260C%%     printf(fmt120, iaopt);
2261C%%     for (i = 0; i <= ny; i++) printf(fmt125, fpin[i]);
2262C%%     printf ("\n");}
2263C++ END
2264c          Check cases: 31 => good data, 32 => bad data.
2265      if (IAOPT .eq. 31) go to 1180
2266      if (IAOPT .eq. 32) then
2267         if (FPIN(LY+1) .eq. 0.D0) go to 1120
2268c                  Have a bad Y, skip the data points.
2269C++ CODE for ~.C. is active
2270         read (IOTEMP) IAOPT, (FPIN(J), J = 1, NY+1)
2271         if (DATSAV) write (IOTMP2) IAOPT, (FPIN(J), J = 1, NY+1)
2272         if (IP(LDEBUG) .gt. 1)
2273     1     print 120, DB, IOTEMP, IAOPT,  (FPIN(J), J=1,NY+1)
2274C++ CODE for .C. is inactive
2275C%%      fread(&iaopt, sizeof(iaopt), (size_t)1, iotemp);
2276C%%      fread(fpin, sizeof(fpin[0]), (size_t)(ny+1), iotemp);
2277C%%      if (datsav) {
2278C%%        fwrite(&iaopt, sizeof(iaopt), (size_t)1, iotmp2);
2279C%%        fwrite(fpin, sizeof(fpin[0]), (size_t)(ny+1), iotmp2);}
2280C%%      if (dplotb.ip[LDEBUG-1] > 1) {
2281C%%        printf(fmt120, iaopt);
2282C%%        for (i = 0; i <= ny; i++) printf(fmt125, fpin[i]);
2283C%%        printf ("\n");}
2284C++ END
2285         if ((FP(LBAD).eq.0.D0) .or. (KSYMB.gt.0)) go to 1120
2286c  Point is not simply ignored.  End this curve and start a new one.
2287         BADPT = .true.
2288      else
2289c                  Curve is being continued
2290         LAST = nint(FPIN(1))
2291         if (LAST .eq. 5) go to 890
2292      end if
2293c           Finish current curve segment.
2294      if (MODE .le. 2) then
2295         if (KPT .gt. 0) call DPLOTF(KPT,XOUT,XOUT,YOUT)
2296         call DPLOTF(0, XOUT, XOUT, YOUT)
2297         if (IOP1 .le. -100) go to 1500
2298      else
2299         if (KPT .gt. 0) call DPLOTL(KPT, XOUT, YOUT)
2300         call DPLOTL(0, XOUT, YOUT)
2301      end if
2302      if (BADPT) then
2303c                       Consume till we get a good point.
2304 1160    continue
2305C++ CODE for ~.C. is active
2306         read (IOTEMP) IAOPT, (FPIN(J), J = 1, NY+1)
2307         if (DATSAV) write (IOTMP2) IAOPT, (FPIN(J), J = 1, NY+1)
2308         if (IP(LDEBUG) .gt. 1)
2309     1     print 120, DB, IOTEMP, IAOPT,  (FPIN(J), J=1,NY+1)
2310C++ CODE for .C. is inactive
2311C%%      fread(&iaopt, sizeof(iaopt), (size_t)1, iotemp);
2312C%%      fread(fpin, sizeof(fpin[0]), (size_t)(ny+1), iotemp);
2313C%%      if (datsav) {
2314C%%        fwrite(&iaopt, sizeof(iaopt), (size_t)1, iotmp2);
2315C%%        fwrite(fpin, sizeof(fpin[0]), (size_t)(ny+1), iotmp2);}
2316C%%      if (dplotb.ip[LDEBUG-1] > 1) {
2317C%%        printf(fmt120, iaopt);
2318C%%        for (i = 0; i <= ny; i++) printf(fmt125, fpin[i]);
2319C%%        printf ("\n");}
2320C++ END
2321         if (IAOPT .eq. 32) then
2322            if (FPIN(LY+1) .ne. 0.D0) then
2323C++ CODE for ~.C. is active
2324               read (IOTEMP) IAOPT, (FPIN(J), J = 1, NY+1)
2325               if (DATSAV) write (IOTMP2) IAOPT, (FPIN(J), J = 1, NY+1)
2326               if (IP(LDEBUG).gt.1)
2327     1           print 120, DB, IOTEMP, IAOPT,(FPIN(J),J=1,NY+1)
2328C++ CODE for .C. is inactive
2329C%%            fread(&iaopt, sizeof(iaopt), (size_t)1, iotemp);
2330C%%            fread(fpin, sizeof(fpin[0]), (size_t)(ny+1), iotemp);
2331C%%            if (datsav) {
2332C%%              fwrite(&iaopt, sizeof(iaopt), (size_t)1, iotmp2);
2333C%%              fwrite(fpin, sizeof(fpin[0]), (size_t)(ny+1), iotmp2);}
2334C%%            if (dplotb.ip[LDEBUG-1] > 1) {
2335C%%              printf(fmt120, iaopt);
2336C%%              for (i = 0; i <= ny; i++) printf(fmt125, fpin[i]);
2337C%%              printf ("\n");}
2338C++ END
2339               go to 1160
2340            end if
2341         end if
2342      end if
2343c                  If IAOPT .eq. 31, we have a point for a new curve.
2344      if (IAOPT .eq. 31) go to 1080
2345c                  Done with the current curve.
2346 1170 KSYMB = -1
2347      LAST = nint(FPIN(1))
2348      if (LAST .le. 3) then
2349         if (MOREIY) then
2350            IY = IY + 1
2351            if (DATSAV) then
2352               IOSTA = -1
2353c%%            iotemp = iotmp2;
2354               IOTEMP = IOTMP2
2355            else
2356              if (IP(LDEBUG) .gt. 1) print '(''Rewind IOTEMP'')'
2357C%%            rewind(iotemp);
2358              rewind(IOTEMP)
2359          end if
2360            go to 860
2361         end if
2362c                          Done with one mfpic segment.
2363         if (IOSTA .gt. 0) then
2364c                       Switch to second scratch file.
2365            IOSTA = -1
2366c                       Following write serves as an endfile.
2367C%%         fwrite(&iaopt, sizeof(iaopt), (size_t)1, iotmp2);
2368            write(IOTMP2) IAOPT
2369c%%         iotemp = iotmp2;
2370            IOTEMP = IOTMP2
2371         end if
2372         MODE = NMODE
2373         if (MODE .ne. 10) go to 840
2374         go to 1300
2375      end if
2376      if (MODE .le. 5) then
2377         MODE = 0
2378         IP(INTERP) = 0
2379      end if
2380      go to 890
2381c
2382c              Convert to physical coordinates and send point out.
2383 1180 KPT = KPT + 1
2384      XOUT(KPT) = XYBASE(KX) + XYU2PF(KX) * FPIN(1)
2385      YOUT(KPT) = XYBASE(KY) + XYU2PF(KY) * FPIN(LY+1)
2386      if (MODE .ge. 2) then
2387c                   Check for clipping
2388         if (KLIP(KX) .or. KLIP(KY)) then
2389            if ((XOUT(KPT) .lt. XYLIM(1, KX)) .or.
2390     1          (XOUT(KPT) .gt. XYLIM(2, KX)) .or.
2391     2          (YOUT(KPT) .lt. XYLIM(1, KY)) .or.
2392     3          (XOUT(KPT) .gt. XYLIM(2, KY))) then
2393               if (KSYMB .ge. 0) go to 1120
2394               if (LKLIP) then
2395                  XOUT(1) = XOUT(2)
2396                  YOUT(1) = YOUT(2)
2397                  go to 1120
2398               end if
2399               LKLIP = .true.
2400               if (KPT .eq. 1) go to 1120
2401               K1 = KPT - 1
2402               K2 = KPT
2403            else if (LKLIP) then
2404               LKLIP = .false.
2405               K1 = 2
2406               K2 = 1
2407            else
2408               go to 1190
2409            end if
2410c                     Make up fake point
2411            FPIN(1) = XOUT(K2)
2412            FPIN(2) = YOUT(K2)
2413            if ((FPIN(1) .lt. XYLIM(1, KX)) .or.
2414     1          (FPIN(1) .gt. XYLIM(2, KX))) then
2415               XOUT(K2) = max(XYLIM(1,KX), min(FPIN(1),XYLIM(2, KX)))
2416               YOUT(K2) = YOUT(K1) + (XOUT(K2) - XOUT(K1)) *
2417     1            (FPIN(2) - YOUT(K1)) / (FPIN(1) - XOUT(K1))
2418            end if
2419            FPIN(3) = XOUT(KPT)
2420            FPIN(4) = YOUT(KPT)
2421            if ((FPIN(4) .lt. XYLIM(1, KY)) .or.
2422     1          (FPIN(4) .gt. XYLIM(2, KY))) then
2423               YOUT(K2) = max(XYLIM(1,KY), min(FPIN(4),XYLIM(2, KY)))
2424               XOUT(K2) = XOUT(K1) + (YOUT(K2) - YOUT(K1)) *
2425     1            (FPIN(3) - XOUT(K1)) / (FPIN(4) - YOUT(K1))
2426            end if
2427            if (LKLIP) then
2428               call DPLOTL(KPT, XOUT, YOUT)
2429               call DPLOTL(0, XOUT, YOUT)
2430               KPT = 1
2431               XOUT(1) = FPIN(1)
2432               YOUT(1) = FPIN(2)
2433c                     Start a new curve.
2434               go to 1080
2435            end if
2436         end if
2437 1190    if (KSYMB .ge. 0) then
2438            KPT = 0
2439            FP(LY) = FP(1)
2440            call DPLOTR(FPIN(LY), KSYMB, KX, KY)
2441            go to 1120
2442         end if
2443      end if
2444      if (KPT .lt. MAXPT) go to 1120
2445      KPT = 0
2446      if (MODE .le. 2) then
2447         call DPLOTF(MAXPT, XOUT, XOUT, YOUT)
2448         if (IOP1 .le. -100) go to 1500
2449         go to 1120
2450      else
2451         call DPLOTL(MAXPT-1, XOUT, YOUT)
2452         XOUT(1) = XOUT(MAXPT)
2453         YOUT(1) = YOUT(MAXPT)
2454         go to 1120
2455      end if
2456 1200 continue
2457C%%   puts( "Bad action index in processing scratch file." );
2458C%%   close_units();
2459C%%   puts( "[Stop]" );
2460C%%   exit(0);
2461      stop 'Bad action index in processing scratch file.'
2462c
2463c Got to end of current processing
2464 1300 MODE = NMODE
2465      if (MODE .ne. 10) go to 840
2466      K = MBORD(8, 5) + MBORD(8, 6)
2467      if (IOSTA .lt. 0) then
2468         if ((K .ne. 0) .or. (LAST .ge. 3)) then
2469c                      Close out this mfpic group and start next.
2470            IPLOT = -100 - IPLOT
2471            call DPLOT9
2472         end if
2473         IOSTA = 1
2474
2475         if (IP(LDEBUG) .gt. 1) print '(''Rewind IOTEMP'')'
2476C++ CODE for ~.C. is active
2477         rewind (IOTEMP)
2478         IOTEMP = IOTMP1
2479C++ CODE for .C. is inactive
2480C%%      rewind(iotemp);
2481c%%      iotemp = iotmp1;
2482C++ END
2483         if (LAST .ge. 3) go to 830
2484         if (K .eq. 0) then
2485C%%         fclose(iotmp2);
2486            close (IOTMP2)
2487         else
2488           if (IP(LDEBUG) .gt. 1) print '(''Rewind IOTMP2'')'
2489C%%         rewind(iotmp2);
2490           rewind (IOTMP2)
2491         end if
2492      end if
2493      if (K .ne. 0) then
2494         if (MBORD(8, 5) .ne. 0) MBORD(3, 2) = MBORD(3, 2)+MBORD(8, 5)+2
2495         if (MBORD(8, 6) .ne. 0) MBORD(3, 4) = MBORD(3, 4)+MBORD(8, 6)+2
2496         do 1320 I = 1, 6
2497            MBORD(8, I) = 0
2498 1320    continue
2499         if (IP(LDEBUG) .gt. 1) print '(''Rewind IOTMP1,IOTMP2,IOFIL'')'
2500C++ CODE for ~.C. is active
2501         rewind(IOTMP1)
2502         rewind(IOTMP2)
2503         rewind(IOFIL)
2504C++ CODE for .C. is inactive
2505C%%      rewind(iotmp1);
2506C%%      rewind(iotmp2);
2507C%%      rewind(iofil);
2508C++ END
2509         LENTXT(3, 17) = 0
2510         go to 800
2511      end if
2512c                     All done, exit.
2513      call DPLOT9
2514C%%   fclose(iofil);
2515      close (IOFIL)
2516C%%   fclose(iotemp);
2517      close (IOTEMP)
2518      LAST = 0
2519      if (IOP1 .le. -100) go to 1500
2520      return
2521c
2522c   **************************** Error Processing **********************
2523c
2524c                     Set Limits for COPT error message.
2525 1400 J = LTEXT - 1
2526 1410 IERR3 = J
2527      IERR4 = LTEXT
2528c                     Set limit for OPT error message
2529 1430 IERR2 = IOP
2530c                     Output Fatal Error Message
2531      call DPLOTE(IERR, OPT, COPT)
2532c                     Error on inner subroutine
2533 1500 LAST = 0
2534 1510 OPT(1) = -100 - IOP1
2535      return
2536      end
2537
2538
2539      subroutine DPLOTA(IB)
2540c Output the single border or axes with index IB, including tick marks,
2541c labels and captions.  Do any preliminary checks on scaling required
2542c and open the output file if it is not open yet.
2543c
2544c ************************* Usage of internal variables ****************
2545c
2546c ADJIN  Space required around borders so points and curves don't
2547c     interfere with tick marks.
2548c ADJOUT Length of space outside of borders.  (Not counting captions.)
2549c ARREXT Parameter giving the amount added to border or axis when there
2550c     an arrow head.  (All numbers like this are in points.)
2551c AXADJ  Array used to define direction to move from the border when
2552c     placing labels.
2553c CAPLOC Array giving caption locations relative to various borders.  If
2554c   > 0, caption is centered on its associated axis, else it goes on an
2555c   end of the associated axis.
2556c CAPSEP Separation between caption and labels.
2557c FAC    Gives the lower limit on number of points per major tick that
2558c        are required when the leading digit of the increment is 1, 2,
2559c        5, and 10.
2560c FDIG   Gives the first digit as a function of KDIG.
2561c IAXP   3-IAX, opposite from the horiz/vert. dirction implied by IB.
2562c IBCAP  The index of the border where the caption for border I goes.
2563c KB     Initially set from MBORD(6, IB).  This is used in deciding
2564c   whether the endpoint should be expanded, and if so, whether to a
2565c   minor or major tick mark.  If < 3 there is no range expansion, if
2566c   2 expansion is to a major tick, it 1 it is to the first minor or
2567c   major tick, and 0 is the same as 1, unless the first major tick
2568c   is at 0 in which case it expands to 0.
2569c KDIG   Values of 1, 2, 3, 4, correspond to starting digits of 1, 2, 5,
2570c   10.
2571c KLOG   Value from IP(LXBORD or LYBORD), with values from there
2572c   incremented by 1 if this value is not zero.  A value of 1 is then
2573c   used to indicate that we don't have room for ticks with logarithmic
2574c   spacing.
2575c MINTIC Number of minor tick intervals per major tick interval.  -9 is
2576c   used to flag logarithmic spacing of the minor tick marks.
2577c POSLAB Offset of label from border/axis for the 17 usual cases.
2578c SEPLAB Separation of labels from border or tickmarks.
2579c SIZEP  Physical size available for plotting in the current direction.
2580c TICLOG When have logarithmically spaced minor tick marks, give the
2581c   location of the first minor tick in user coordinates.
2582c TICMAJ Distance between major tick marks, first in user coordinates,
2583c   later converted to physcial coordinates in points.
2584c TICLEN Temp. used to hold tick length.
2585c TICMIN As for TICMAJ, but for minor tick marks.
2586c TBASE  Base point for major ticks (nominally 0).  Major ticks are
2587c   all at TBASE + k * TICMAJ, where k is an integer.  Starts in
2588c   user coordinates and later is in physical coordinates.
2589c TP1    Temporary use.
2590c TP2    Temporary use.
2591c TP3    Temporary use.
2592c TLEN   Length of the variable range is user coordinates.
2593c TPMIN  Used tracking a temporary value for the minimum.
2594c TPMAX  Used tracking a temporary value for the maximum.
2595c VAL    Numeric value of label being output.
2596c XFAC   Physical space available / Length in user coordinates.
2597c XYPOS  Gives a point (x, y).
2598c XYPOS1 Gives a point (x_1, y_1).
2599c XYPOS2 Gives a point (x_2, y_2).
2600c
2601c *************************** Variable Declarations ********************
2602c
2603c Common
2604c  For DPLOT0
2605      double precision ARRLEN, PXO, PXSIZE, PYO, PYSIZE
2606C++ CODE for ~.C. is active
2607      integer IOFIL, IPLOT, KURPEN, LASPEN
2608      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
2609     1   IOFIL, IPLOT, KURPEN, LASPEN
2610C++ CODE for .C. is inactive
2611C      integer IPLOT, KURPEN, LASPEN
2612C      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
2613C     1   IPLOT, KURPEN, LASPEN
2614C++ END
2615      save /DPLOTD/
2616c
2617c         Parameter pointers for integers in IP.
2618      integer NEXT, INTERP, LCOOX,LCOOY,LXLINE,LXBORD,LYBORD, LTYPE,
2619     1  KSET, LTANNO, LPEN, NBORD, LYDIM, LNY, LDEBUG,
2620     2  LASTIP
2621      parameter (NEXT=1, INTERP=2, LCOOX=3, LCOOY=4, LXLINE=5,
2622     1  LXBORD=6, LYBORD=7, LTYPE=8, KSET=9, LTANNO=10, LPEN=13,
2623     2  NBORD=14, LYDIM=15, LNY=16, LDEBUG=18, LASTIP=LDEBUG)
2624c          Parameter pointers for floats in FP.
2625      integer LARROW,LWIDTH,LWIDRE,LBAD,LVALS,LXYSIZ,LASTFP,LFDAT
2626      parameter (LARROW=1, LWIDTH=2, LWIDRE=6, LBAD=7,
2627     1  LVALS=9, LXYSIZ=LVALS+5, LASTFP=LXYSIZ+2,LFDAT=LBAD)
2628c          Parameter for various sizes.
2629      integer LBNDC, LBNDF, LBNDP, LBNDT, MAXSET
2630      parameter (LBNDC=128, LBNDF=32, LBNDP=4, LBNDT=64, MAXSET=20)
2631      double precision BORLOC(6), FILL(19), FP(LASTFP), OVLAP,
2632     1  PHYUSE(2,2), SETLIM(2,2), TLENH, TLENV, TICKS(4,6), TOPTS,
2633     2  VHLEN(2), XYBASE(MAXSET), XYLIM(2,MAXSET), XYU2PF(MAXSET)
2634      integer IERR1, IERR2, IERR3, IERR4, IOP1, IP(LASTIP), JSET(2),
2635     1  LENCAP(6), LENTXT(3,18), MANNO, MBORD(8,6), MFILL(4), NTEXT,
2636     2  NXYLIM(MAXSET)
2637      logical  KLIP(MAXSET), NOOUT, OPAQUE
2638      common / DPLOTB / BORLOC, FILL, FP, OVLAP, PHYUSE, SETLIM, TICKS,
2639     1  TLENH, TLENV, TOPTS, VHLEN, XYBASE, XYLIM, XYU2PF, IERR1,
2640     2  IERR2, IERR3, IERR4, IOP1, IP, JSET, LENCAP, LENTXT, MANNO,
2641     3  MBORD, NTEXT, NXYLIM, KLIP, MFILL, NOOUT, OPAQUE
2642c
2643      character FMTNUM(17)*(LBNDF), CAPTIO(6)*(LBNDC), POS*68, TEXT*280,
2644     1    TXTDEF(18)*(LBNDT)
2645      common / DPLOTC / FMTNUM, CAPTIO, POS, TEXT, TXTDEF
2646      save /DPLOTB/, /DPLOTC/
2647c Locals
2648      integer IB
2649      double precision ARREXT, CAPSEP, SEPLAB
2650      parameter (ARREXT=3.D0, CAPSEP = 2.D0, SEPLAB = 3.5D0)
2651
2652      integer I, I1, I2, IAX, IAXP, IBCAP(6), J, K, KB, KDIG, KLOG,
2653     1   MINTIC
2654      double precision ADJIN(6), ADJOUT(6), AXADJ(6), CAPLOC(6), FAC(4),
2655     1   FDIG(4), LOGINT(10), POSLAB(6), SIZEP, TBASE, TICMAJ, TICLEN,
2656     2   TICLOG, TICMIN, TLEN, TP, TP1, TP2, TP3, TPMIN, TPMAX, VAL,
2657     3   XFAC, XYPOS(2), XYPOS1(2), XYPOS2(2)
2658      save ADJOUT, CAPLOC, POSLAB
2659      data AXADJ / 1.D0, 1.D0, -1.D0, -1.D0, 1.D0, 1.D0 /
2660      data FAC  / 24.D0, 20.D0, 24.D0, 0.D0 /
2661      data FDIG / 1.D0, 2.D0, 5.D0, 10.D0 /
2662      data LOGINT/ 0.D0, .3010299957D0, .47771212547D0, .6020599913D0,
2663     1    .6989700043D0, .7781512503D0, .8450980400D0, .9030899870D0,
2664     2    .9542425094D0, 1.D0 /
2665      save ADJIN
2666c
2667c ************************ Start of Executable Code ********************
2668c
2669      if (MBORD(8,1) .eq. 0) then
2670c           First time this routine has been called for this figure.
2671         if (LENTXT(3, 17) .gt. 0) then
2672C++ CODE for ~.C. is active
2673            call DPLOTU (IOFIL, TXTDEF(17)(1:LENTXT(3,17)))
2674            if (IOP1 .le. -10) return
2675C++ CODE for .C. is inactive
2676C%%         iofil = fopen(dplotc.txtdef[16], "w");
2677C%%         if (iofil == NULL) return;
2678C++ END
2679         end if
2680         CAPLOC(1) = 0.D0
2681         CAPLOC(2) = 0.D0
2682         CAPLOC(3) = 0.D0
2683         CAPLOC(4) = 0.D0
2684         CAPLOC(5) = 0.D0
2685         CAPLOC(6) = 0.D0
2686         I1 = 1
2687         I2 = 6
2688      else
2689         if (IB .gt. 10) go to 300
2690         I1 = IB
2691         I2 = IB
2692      end if
2693      do 10 I = I1, I2
2694c                       Get initial border characteristics
2695         IAX = 2 - mod(I, 2)
2696         if (MBORD(8, I) .ne. 0) go to 30
2697         if (I .le. 4) MBORD(8, I) = JSET(IAX)
2698         NOOUT = .true.
2699c                       Adjustment for tick marks
2700         ADJOUT(I) = -min(0.D0,min(TICKS(1,I),TICKS(2,I)))
2701c
2702         K = MBORD(1, I)
2703         if ((K .gt. 1) .and. (I .le. 4)) then
2704c                         Get space for labels.
2705            if (K .gt. 2) then
2706              TPMIN = XYLIM(1, IAX)
2707              TPMAX = XYLIM(2, IAX)
2708              if (SETLIM(1, IAX) .lt. SETLIM(2, IAX)) then
2709                 TPMIN = SETLIM(1, IAX)
2710                 TPMAX = SETLIM(2, IAX)
2711               end if
2712               TP = max(abs(TPMIN), abs(TPMAX))
2713               if (IP(LXBORD+IAX-1) .eq. 1) then
2714                  TP1 = anint(TP)
2715                  J = -I
2716               else
2717                  K = log10(TP)
2718                  TP1 = 10.D0 ** K
2719                  TLEN = TPMAX - TPMIN
2720                  J = log10(TP / TLEN)
2721                  if (J .gt. 1) then
2722                     TP1 = TP1 * 1.1D0**J
2723                  end if
2724                  J = I
2725               end if
2726               call DPLOTN(sign(TP1,TPMIN), J, XYPOS)
2727               TP1 = TLENV
2728               if (IAX .eq. 2) TP1 = TLENH
2729
2730               POSLAB(I) = ADJOUT(I) + SEPLAB
2731               ADJOUT(I) = POSLAB(I) + TP1
2732               if ((I.eq.1) .or. (I.eq.5)) then
2733                   ADJOUT(I) = ADJOUT(I) - 2.D0
2734                   POSLAB(I) = POSLAB(I) - 2.D0 + TP1
2735               end if
2736            end if
2737         end if
2738c              Remember info. on arrows.
2739         if (MBORD(2, I) .gt. 0) then
2740            TP1 = MBORD(2, I) + ARREXT
2741            if (LENCAP(I) .ne. 0) TP1 = TP1 + CAPSEP
2742c                     Remember adjustment for caption if needed.
2743            if (CAPLOC(I) .le. 0.D0) CAPLOC(I) = CAPLOC(I) - TP1
2744         end if
2745         if (LENCAP(I) .ne. 0) then
2746c                       Have a caption need to get space required
2747            NTEXT = LENCAP(I)
2748C%%         memcpy(dplotc.text,dplotc.captio[i-1],(size_t)dplotb.ntext);
2749            TEXT(1:NTEXT) = CAPTIO(I)(1:NTEXT)
2750            call DPLOTT( I+10, XYPOS)
2751            IAXP = 3 - IAX
2752            K = 4 * I + 32
2753            IBCAP(I) = I
2754    5       if (POS(K+IAXP:K+IAXP) .eq. 'c') then
2755               if (I .ge. 5) then
2756c                            Error -- Can't center on x or y axis
2757                  call DPLOTE(2, XYPOS, ' ')
2758                  POS(K+IAXP:K+IAXP) = 'r'
2759                  if (I .eq. 6) POS(K+IAXP:K+IAXP) = 't'
2760                  go to 5
2761               end if
2762               CAPLOC(I) = POSLAB(I) + VHLEN(IAX) + CAPSEP
2763               ADJOUT(I) = CAPLOC(I)
2764            else
2765               J = index('bltr', POS(K+IAXP:K+IAXP))
2766               IBCAP(I) = J
2767               TP1 = VHLEN(IAXP) + CAPSEP
2768               if (mod(J, 2) .eq. 1) TP1 = TP1 - 2.D0
2769               CAPLOC(I) = CAPLOC(I) - TP1
2770            end if
2771         end if
2772         ADJIN(I) = MBORD(3, I)
2773         if (MBORD(4, I) .ne. 0) then
2774            TP = ADJOUT(I)
2775            ADJOUT(I) = MBORD(4, I)
2776            if (CAPLOC(I) .gt. 0.D0) then
2777               CAPLOC(I) = ADJOUT(I)
2778               POSLAB(I) = POSLAB(I) + .5D0 * (ADJOUT(I) - TP)
2779            else
2780               POSLAB(I) = ADJOUT(I)
2781            end if
2782         end if
2783         if (ADJOUT(I) + ADJIN(I) .gt. 100.D0) then
2784c                             Error -- too much space wasted at border I
2785           IERR1 = I
2786           call DPLOTE(3, XYPOS, ' ')
2787         end if
2788   10 continue
2789      if (I1 .ne. I2) then
2790c                       Special setting the first time.
2791         do 20 I = 1, 6
2792            if (CAPLOC(I) .lt. 0) ADJOUT(IBCAP(I)) =
2793     1         max(ADJOUT(IBCAP(I)), -CAPLOC(I))
2794   20    continue
2795         BORLOC(1) = 0.D0
2796         BORLOC(2) = 0.D0
2797         BORLOC(3) = TOPTS * FP(LXYSIZ+1) - ADJOUT(1)
2798         BORLOC(4) = TOPTS * FP(LXYSIZ) - ADJOUT(2)
2799c                                            Initialize mfpic
2800         IPLOT = IP(LTYPE)
2801         PXO = ADJOUT(2)
2802         PYO = ADJOUT(1)
2803         PXSIZE = BORLOC(4)
2804         PYSIZE = BORLOC(3)
2805         call DPLOT0
2806         BORLOC(3) = BORLOC(3) - ADJOUT(3)
2807         BORLOC(4) = BORLOC(4) - ADJOUT(4)
2808         IAX = 2 - mod(IB, 2)
2809C++ CODE for ~.C. is active
2810         if (IP(LDEBUG).gt.0) print '(/'' ADJOUT(1:4)='',1P,4G17.10/)',
2811     1      (ADJOUT(I), I = 1, 4)
2812C++ CODE for .C. is inactive
2813C%%      if (dplotb.ip[LDEBUG-1] > 0) printf(
2814C%%         "\n ADJOUT(1:4)=%17.10g%17.10g%17.10g%17.10g\n", adjout[0],
2815C%%         adjout[1], adjout[2], adjout[3]);
2816C++ END
2817      end if
2818c                        Process the border or axis
2819   30 ADJIN(IB) = MBORD(3, IB)
2820      SIZEP=BORLOC(5-IAX)-BORLOC(3-IAX)-ADJIN(5-IAX)-ADJIN(3-IAX)
2821      if (SIZEP .le. 10.D0) then
2822c                           Error -- not enough room for plot
2823        call DPLOTE(33, XYPOS, ' ')
2824        return
2825      end if
2826      if (IB .gt. 4) then
2827         if (IB .eq. 6) then
2828c               Take care of drawing lines at X = 0 and Y = 0, if any.
2829            if (IP(LXLINE) .ne. 1) then
2830               I = IP(LXLINE)
2831               if (I .le. 6) then
2832                  I = I - 1
2833                  if (I .lt. 0) I = 6
2834               end if
2835               I = I - 1
2836   40          J = MOD(I, 4) + 1
2837c                       If 0 in range, draw line off axis J
2838               K = MBORD(8, J)
2839               do 50 I1 = 1, MAXSET
2840                  if (NXYLIM(I1) .eq. K) go to 60
2841   50          continue
2842               go to 70
2843   60          TP = XYBASE(I1)
2844               I2 = 1 + mod(I1, 2)
2845               if ((IP(LXBORD+I1-1) .eq. 0) .and.
2846     1           (TP.gt.BORLOC(I2)) .and. (TP.lt.BORLOC(I2+2))) then
2847c                                    Draw the line
2848                  KURPEN = FP(LWIDTH+3)
2849                  if (I2 .eq. 2) then
2850                     call DPLOT2 (TP, BORLOC(1), TP, BORLOC(3))
2851                  else
2852                     call DPLOT2 (BORLOC(2), TP, BORLOC(4), TP)
2853                  end if
2854               end if
2855               I = I - 5
2856               if (I .gt. 0) go to 40
2857               if (I .eq. 0) then
2858                  I = 4
2859                  go to 40
2860               end if
2861            end if
2862         end if
2863c Ignore request for axis if it is not in range of data.
2864   70    if ((SETLIM(1,IAX).ge.0.D0).or.(SETLIM(2,IAX).lt.0.D0)) return
2865c                                 Get physical location of axis.
2866         BORLOC(IB) = XYBASE(IAX)
2867      else if ((XYU2PF(IAX) .eq. 0.D0) .or. (MBORD(1, IB) .gt. 1)) then
2868         KLIP(IAX) = .false.
2869         if (SETLIM(1, IAX) .lt. SETLIM(2, IAX)) then
2870            KLIP(IAX) = (SETLIM(1, IAX) .gt. XYLIM(1, IAX)) .or.
2871     1                  (SETLIM(2, IAX) .lt. XYLIM(2, IAX))
2872            XYLIM(1, IAX) = SETLIM(1, IAX)
2873            XYLIM(2, IAX) = SETLIM(2, IAX)
2874         else
2875            SETLIM(1, IAX) = XYLIM(1, IAX)
2876            SETLIM(2, IAX) = XYLIM(2, IAX)
2877         end if
2878         if (SETLIM(2, IAX) .gt. SETLIM(1, IAX)) then
2879c                 Usual case, other branch protects against divide by 0.
2880            XFAC = SIZEP / (SETLIM(2, IAX) - SETLIM(1, IAX))
2881         else
2882            XFAC = 1.D0
2883         end if
2884      end if
2885c
2886c ******* Get location of ticks and adjust limits if necessary *********
2887c
2888      if (PHYUSE(1,IAX) .ge. 0.D0) then
2889c              User coordinate must map to given physical coordinate.
2890c   TP1 = minimum x_physical, TP2 = loc. user, TP3 = loc. physical
2891         TP1 = BORLOC(3-IAX) + ADJIN(3-IAX)
2892         TP2 = PHYUSE(2, IAX)
2893         TP3 = PHYUSE(1, IAX) * TOPTS
2894c                  Convert to logs if requested
2895         if (IP(LCOOX+IAX-1) .eq. 2) TP2 = log10(TP2)
2896c   TP = maps loc. user to loc. physical with current settings.
2897         TP = TP1 + XFAC * (TP2 - XYLIM(1,IAX))
2898         if (TP .gt. TP3) then
2899            XFAC = (TP3 - TP1) / (TP2 - XYLIM(1,IAX))
2900            XYLIM(2,IAX) = TP1 + XFAC*(XYLIM(2,IAX)-XYLIM(1,IAX))
2901         else if (TP .lt. TP3) then
2902            XYLIM(1,IAX) = TP2 + (TP3 - TP1) / XFAC
2903         end if
2904c  No range expansion in this case (otherwise above adjustment fails)
2905         MBORD(6, IB) = 3
2906      end if
2907      TPMAX = XYLIM(2, IAX)
2908      TPMIN = XYLIM(1, IAX)
2909      TLEN = TPMAX - TPMIN
2910      if (TLEN .eq. 0.D0) then
2911c                         Expand the range
2912         if (TPMAX .eq. 0) then
2913            TPMAX = 1.D0
2914            TPMIN = -1.D0
2915            TLEN = 2.D0
2916         else if (TPMAX .gt. 0) then
2917            TPMIN = 0.D0
2918            TPMAX = 2.D0 * TPMAX
2919         else
2920            TPMAX = 0.D0
2921            TPMIN = 2.D0 * TPMIN
2922         end if
2923      end if
2924      if (MBORD(1, IB) .lt. 2) go to 170
2925c                  There are some kind of tick marks.
2926      KLOG = IP(LXBORD+IB-1)
2927      if (KLOG .ne. 0) KLOG = KLOG + 1
2928      TICMAJ = TICKS(4, IB)
2929      if (TICMAJ .ne. 0.D0) then
2930c                            Major ticks all specified
2931         TBASE = TICKS(3, IB)
2932         if (KLOG .eq. 2) then
2933            KDIG = TICMAJ
2934            if (KDIG .ne. 1) KLOG = 1
2935         else
2936            KDIG = log10(.98D0 * TBASE)
2937            KDIG = TICMAJ / 10**KDIG
2938         end if
2939         KB = 3
2940      else
2941c If the increment between ticks is 0, we need to compute it.
2942         TBASE = 0.D0
2943         if (KLOG .eq. 2) then
2944c                       Logarithmic spacing with minor ticks.
2945            TICMAJ = 1.D0
2946            TICMIN = 1.D0
2947            MINTIC = -9.D0
2948            if (SIZEP .ge. 24.D0*TLEN) go to 90
2949c                       Not enough room for minor log ticks
2950            KLOG = 1
2951         end if
2952         K =log10(.4 * TLEN)
2953c    TICMAJ = first candidate increment (no bigger than needed)
2954         TICMAJ = 10.D0 ** K
2955         if (TICMAJ * SIZEP .gt. FAC(3) * TLEN) then
2956            K = K - 1
2957            TICMAJ = TICMAJ / 10.D0
2958         end if
2959         KDIG = 1
2960         TP2 = TICMAJ
2961c Now TP2 is smallest increment (in user coordinates) for major ticks.
2962c We now decide whether to increase initial size it by 1, 2, 5, or 10.
2963
2964   80    TP1 = TLEN / TICMAJ
2965         if (SIZEP .lt. FAC(KDIG) * TP1) then
2966c   There are less than FAC(KDIG) points per major interval, want more
2967            KDIG = KDIG + 1
2968            TICMAJ = FDIG(KDIG) * TP2
2969            if (KDIG .eq. 2) then
2970               TP = TLEN / (5.D0*TP2)
2971               if (abs(ANINT(TP) - TP) .lt. 1.d-5) then
2972                  if (mod(ANINT(TP), 2.D0) .ne. 0.D0) then
2973c               Using 5.D0 * TP2 breaks even and 2.D0*TP2 doesn't.
2974                     KDIG = 3
2975                     TICMAJ = 5.D0 * TP2
2976                  end if
2977               end if
2978            end if
2979            go to 80
2980         end if
2981      end if
2982c Have now established TICMAJ as the major tick increment
2983      MINTIC = MBORD(5, IB)
2984      if (MINTIC .eq. 0) then
2985         if ((KDIG .eq. 2) .or. (KDIG .eq. 3)) then
2986            MINTIC = FDIG(KDIG)
2987         else
2988            TP1 = SIZEP * TICMAJ / TLEN
2989            if (TP1 .ge. 90.D0) then
2990               MINTIC = 10
2991            else if (TP1 .ge. 60.D0) then
2992               MINTIC = 5
2993            else if (TP1 .ge. 40.D0) then
2994               MINTIC = 4
2995            else if (TP1 .ge. 20.D0) then
2996               MINTIC = 2
2997            else
2998               MINTIC = 1
2999            end if
3000         end if
3001      end if
3002c             And TICMIN is established as the minor tick increment.
3003      TICMIN = TICMAJ / dble(MINTIC)
3004c Adjust the endpoints -- First insure we don't get points too close
3005   90 TP3 = (TPMAX - TPMIN) / SIZEP
3006c                  TP3 used to convert from physical to user coordinates
3007c Now get the the tick marks on borders if that is desired.
3008      KB = MBORD(6, IB)
3009      if (KB .le. 2) then
3010         TP = TICMIN
3011         if (KB .eq. 2) TP = TICMAJ
3012         if (KB .eq. 0) then
3013            if (TPMIN .gt. 0.D0) then
3014               KB = 1
3015               if (TPMIN .le. TICMAJ) TP = TICMAJ
3016            end if
3017         end if
3018         if (KLOG .eq. 2) then
3019c  Minor ticks are spaced logarithmically, tricky to end on a tick mark.
3020            J = (TPMIN - TBASE) / TICMAJ
3021            if (TPMIN .lt. TBASE) J = J - 1
3022            TP1 = TBASE + J * TICMAJ
3023            TP2 = TP1
3024            J = 1
3025  100       if (TP1 + LOGINT(J) .lt. TPMIN) then
3026               TP2 = TP1 + LOGINT(J)
3027               J = J + 1
3028               go to 100
3029            end if
3030            TICLOG = TP2
3031            go to 120
3032         end if
3033         J = (TPMIN - TBASE) / TP
3034         TP2 = TBASE + dble(J)*TP
3035  110    if (TP2 .gt. TPMIN) then
3036            TP2 = TP2 - TP
3037            go to 110
3038         end if
3039  120    TPMIN = min(TP2, TPMIN - TP3 * ADJIN(3-IAX))
3040         if (KB .le. 1) then
3041c                    If get here, TP = TICMIN
3042            if (KB .eq. 0) then
3043               if (TPMAX .lt. 0.D0) then
3044                  if (TPMAX .ge. -TICMAJ) then
3045                     TP = TICMAJ
3046                     KB = 2
3047                  end if
3048               end if
3049            else
3050               TP = TICMIN
3051            end if
3052         end if
3053         if (KLOG .eq. 2) then
3054c                               Logarithmic minor ticks.
3055            J = (TPMAX - TBASE) / TICMAJ
3056            if (TPMAX .lt. TBASE) J = J - 1
3057            TP1 = TBASE + J * TICMAJ
3058            TP2 = TP1
3059            J = 1
3060  140       if (TP2 .lt. TPMAX) then
3061               J = J + 1
3062               TP2 = TP1 + LOGINT(J)
3063               go to 140
3064            end if
3065            go to 160
3066         end if
3067         J = (TPMAX - TBASE) / TP
3068         TP2 = TBASE + dble(J)*TP
3069  150    if (TP2 .lt. TPMAX) then
3070            TP2 = TP2 + TP
3071            go to 150
3072         end if
3073      end if
3074  160 TPMAX = max(TP2, TPMAX + TP3 * ADJIN(5-IAX))
3075c               Set transformation parameters
3076  170 if (XYU2PF(IAX) .ne. 0.D0) then
3077         if (MBORD(1, IB) .le. 1) go to 180
3078      end if
3079      XYU2PF(IAX) = (BORLOC(5-IAX) - BORLOC(3-IAX)) / (TPMAX - TPMIN)
3080      XYBASE(IAX) = -XYU2PF(IAX) * TPMIN
3081c Let v=x if IAX = 1, and v=y otherwise.  V is mapped to physical
3082c coordinates by  v_{physical) = XYBASE(IAX) + v * XYU2PF(IAX)
3083      TBASE = XYBASE(IAX) + XYU2PF(IAX) * TBASE
3084      TICMIN = TICMIN * XYU2PF(IAX)
3085      TICMAJ = TICMAJ * XYU2PF(IAX)
3086      if (KLIP(IAX)) then
3087         XYLIM(1,IAX) = XYBASE(IAX) + XYU2PF(IAX) * SETLIM(1, IAX)
3088         XYLIM(2,IAX) = XYBASE(IAX) + XYU2PF(IAX) * SETLIM(2, IAX)
3089      else
3090         XYLIM(1,IAX) = XYBASE(IAX) + XYU2PF(IAX) * XYLIM(1, IAX)
3091         XYLIM(2,IAX) = XYBASE(IAX) + XYU2PF(IAX) * XYLIM(2, IAX)
3092      end if
3093c
3094c ***************** Output Caption, Border/axis, labels ****************
3095c
3096c                    First the caption
3097  180 NOOUT = .false.
3098      if (LENCAP(IB) .ne. 0) then
3099c                                Have a caption
3100         J = IBCAP(IB)
3101         if (J .eq. IB) then
3102c                            Caption is being centered
3103            XYPOS(IAX) = .5D0 * BORLOC(5-IAX)
3104            XYPOS(3-IAX) = BORLOC(IB) - AXADJ(IB) * CAPLOC(IB)
3105         else
3106            XYPOS(IAX) = BORLOC(J) + AXADJ(J) * CAPLOC(IB)
3107            XYPOS(3-IAX) = BORLOC(IB)
3108         end if
3109         NTEXT = LENCAP(IB)
3110C%%      memcpy(dplotc.text, dplotc.captio[ib-1],(size_t)dplotb.ntext);
3111         TEXT(1:NTEXT) = CAPTIO(IB)(1:NTEXT)
3112         call DPLOTT( IB+9, XYPOS)
3113      end if
3114      if (MBORD(1, IB) .eq. 0) return
3115c
3116c                     Now the Border/axis line
3117      KURPEN = FP(LWIDTH)
3118      XYPOS1(1) = BORLOC(2)
3119      XYPOS1(2) = BORLOC(1)
3120      XYPOS2(1) = BORLOC(4)
3121      XYPOS2(2) = BORLOC(3)
3122      TICLEN = min(TICKS(1,IB), BORLOC(IAX+2) - BORLOC(IAX))
3123      if (IB .le. 2) then
3124          XYPOS2(3-IAX) = BORLOC(IB)
3125      else if (IB .le. 4) then
3126          XYPOS1(3-IAX) = BORLOC(IB)
3127          TICLEN = -TICLEN
3128      else
3129          XYPOS1(3-IAX) = BORLOC(IB)
3130          XYPOS2(3-IAX) = BORLOC(IB)
3131      end if
3132
3133      if (MBORD(2, IB) .ne. 0) then
3134         ARRLEN = MBORD(2, IB)
3135         XYPOS2(IAX) = XYPOS2(IAX) + ARRLEN + ARREXT
3136      end if
3137
3138      call DPLOT2 (XYPOS1(1), XYPOS1(2), XYPOS2(1), XYPOS2(2))
3139      K = MBORD(1, IB)
3140      if (K .gt. 1) then
3141c## Code for polar cases yet to be written.
3142c                                    Major ticks
3143         TP1 = mod(TBASE - BORLOC(3-IAX), TICMAJ)
3144         if (TP1 .lt. 0) TP1 = TICMAJ + TP1
3145         if (TP1 .gt. .99999*TICMAJ) TP1 = TP1 - TICMAJ
3146         TP1 = TP1 + BORLOC(3-IAX)
3147         call DPLOT8 (FP(LWIDTH+1), TP1+ADJOUT(3-IAX), TICMAJ,
3148     1      BORLOC(5-IAX)+ADJOUT(3-IAX)+.1D0, BORLOC(IB)+ADJOUT(IAX),
3149     2      BORLOC(IB)+TICLEN+ADJOUT(IAX), IAX, -1.D0)
3150         if (MINTIC .gt. 1) then
3151c                                    Minor ticks
3152            TP2 = mod(TBASE - BORLOC(3-IAX), TICMIN)
3153            if (TP2 .lt. 0) TP2 = TICMIN + TP2
3154            TP2 = TP2 + BORLOC(3-IAX)
3155            TICLEN = min(TICKS(2,IB), BORLOC(IAX+2) - BORLOC(IAX))
3156            if ((IB .eq. 3) .or. (IB .eq. 4)) TICLEN = -TICLEN
3157            call DPLOT8 (FP(LWIDTH+2), TP2+ADJOUT(3-IAX), TICMIN,
3158     1         BORLOC(5-IAX)+ADJOUT(3-IAX)+.1D0, BORLOC(IB)+ADJOUT(IAX),
3159     2         BORLOC(IB)+TICLEN+ADJOUT(IAX), IAX, -1.D0)
3160         else if (KLOG .eq. 2) then
3161c                                    Logarithmic minor ticks
3162            TICLEN = min(TICKS(2,IB), BORLOC(IAX+2) - BORLOC(IAX))
3163            call DPLOT8 (FP(LWIDTH+2), TP1+ADJOUT(3-IAX), TICMAJ,
3164     1         BORLOC(5-IAX)+ADJOUT(3-IAX)+.1D0, BORLOC(IB)+ADJOUT(IAX),
3165     2         BORLOC(IB)+TICLEN+ADJOUT(IAX), IAX,
3166     3         XYBASE(IAX)+TICLOG*XYU2PF(IAX)+ADJOUT(3-IAX)-.1D0)
3167         end if
3168c                                    Labels
3169         if (K .gt. 2) then
3170            J = 4*IB - IAX - 1
3171            if (K .le. 4) then
3172               TP1 = TP1 + TICMAJ
3173            else if (TP1 - BORLOC(3-IAX) .lt. 4.D0) then
3174               POS(J:J) = 'l'
3175               if (IAX .eq. 2) POS(J:J) = 'b'
3176            end if
3177            TP2 = BORLOC(5-IAX) - TICMAJ + .1D0
3178            OPAQUE = .false.
3179            OVLAP = -10.D4
3180            XYPOS(3-IAX) = BORLOC(IB) - AXADJ(IB) * POSLAB(IB)
3181c
3182  200       XYPOS(IAX) = TP1
3183            VAL = (TP1 - XYBASE(IAX)) / XYU2PF(IAX)
3184            if (abs(VAL) .lt. 1.D-5 * TICMAJ) VAL = 0
3185            I = IB
3186            if (IP(LXBORD-1+IAX) .eq. 1) I = -I
3187            call DPLOTN(VAL, I, XYPOS)
3188            TP1 = TP1 + TICMAJ
3189            POS(J:J) = 'c'
3190            if (TP1 .le. TP2) go to 200
3191            if (abs(K-4) .ne. 1) then
3192               if (TP1 .le. BORLOC(5-IAX) + .1D0) then
3193                  if (TP1 .ge. BORLOC(5-IAX) - 4.D0) then
3194                     POS(J:J) = 'r'
3195                     if (IAX .eq. 2) POS(J:J) = 't'
3196                  end if
3197                  go to 200
3198               end if
3199            end if
3200         end if
3201      end if
3202      return
3203c
3204c ************ Option 16 -- Lines and border/axis annotations **********
3205c
3206  300 J = IP(LTANNO)
3207      I = IB - 10
3208      IAX = 2 - mod(I, 2)
3209c                         Convert to physical coordinates
3210      if (IP(LCOOX + IAX - 1) .eq. 2) FP(LVALS) = log10(FP(LVALS))
3211      XYPOS1(IAX) = XYBASE(IAX) + XYU2PF(IAX) * FP(LVALS)
3212      if (J .ne. 0) then
3213c                    Want a tick or some kind of line.
3214         KURPEN = FP(LWIDTH+min(IP(LTANNO),3))
3215         if (IP(LTANNO) .eq. 4) KURPEN = KURPEN + 203001
3216         I1 = I + 2
3217         if (I1 .gt. 4) I1 = I1 - 4
3218         XYPOS2(IAX) = XYPOS1(IAX)
3219         XYPOS1(3-IAX) = BORLOC(I)
3220         if (J .gt. 2) then
3221            XYPOS2(3-IAX) = BORLOC(I1)
3222         else
3223            XYPOS2(3-IAX) = XYPOS1(IAX) + TICKS(J, I) * AXADJ(IAX)
3224         end if
3225         call DPLOT2 (XYPOS1(1), XYPOS1(2), XYPOS2(1), XYPOS2(2))
3226      end if
3227      if (NTEXT .eq. 0) return
3228c                Have an  annotation.
3229      XYPOS1(3-IAX) = BORLOC(I) - AXADJ(I) * POSLAB(I)
3230      call DPLOTT( I, XYPOS1)
3231      return
3232      end
3233
3234      subroutine DPLOTE(IERR, OPT, COPT)
3235c                               Prints Error Messages
3236c IERR   indicates the error as follows.
3237c   1 Warning -- Points provided are not being plotted.
3238c   2 Warning -- Centering on x or y axis not allowed.
3239c   3 Warning -- Too much space wasted at border I.
3240c   4 Warning -- Format number out of range.
3241c   5 Warning -- Unknown format specification:
3242c   6 Warning -- Caption doesn''t have balanced {...} or $...$:
3243c  10 Bad option character.
3244c  11 Bad start of COPT option.
3245c  12 Runaway in COPT, unbalanced (), [], or {}?.
3246c  13 Missing #?,
3247c  14 File name or caption is empty.
3248c  15 Text inside (), {}, [], may contain at most $I chars.
3249c  16 [...] must contain 2 or 4 letters.
3250c  17 First position must be one of "tcbTCB".
3251c  18 Second position must be one of "lcrLCR.
3252c  19 Error in third/forth position of [...].
3253c  20 Bad option index.
3254c  21 Option value is not an integer.
3255c  22 Option value is too big to be an integer.
3256c  23 Digit 10^0 of option 1 is too big.
3257c  24 Type flag must be 0 or 1.
3258c  25 Polar coordinates (not implemented) or bad 10^2, 10^3 digit.
3259c  26 Only digits 1 to 6 can be used for borders.
3260c  27 Min/max on x or y specified twice.
3261c  28 NY changed in middle of curve.
3262c  29 Attempting to change data set without providing data.
3263c  30 More than NY symbols.
3264c  31 Bad value for symbol plotting.
3265c  32 Digit 10^0 for option 19, must be < 5.
3266c  33 Not enough room for plot.
3267c  34 Unable to find unused I/O unit number in 10..100.
3268c  35 Unable to open output file:
3269c  40 Internal -- Adding points (in DPLOTF) without initialization.
3270c  41 Internal -- N < -4 on call to DPLOTF.
3271c  42 Internal -- N < 0 and not in initial state in DPLOTF.
3272c  43 Internal -- S values must be increasing in DPLOTF.
3273c OPT    OPT passed in by user.  Only used if 10 < IERR < 33.
3274c COPT   COPT passed in by user.  Only used if 9 < IERR < 20
3275c
3276c Formal Args.
3277      double precision OPT(*)
3278      integer IERR
3279      character COPT*(*)
3280c Common variables
3281c
3282c         Parameter pointers for integers in IP.
3283      integer NEXT, INTERP, LCOOX,LCOOY,LXLINE,LXBORD,LYBORD, LTYPE,
3284     1  KSET, LTANNO, LPEN, NBORD, LYDIM, LNY, LDEBUG,
3285     2  LASTIP
3286      parameter (NEXT=1, INTERP=2, LCOOX=3, LCOOY=4, LXLINE=5,
3287     1  LXBORD=6, LYBORD=7, LTYPE=8, KSET=9, LTANNO=10, LPEN=13,
3288     2  NBORD=14, LYDIM=15, LNY=16, LDEBUG=18, LASTIP=LDEBUG)
3289c          Parameter pointers for floats in FP.
3290      integer LARROW,LWIDTH,LWIDRE,LBAD,LVALS,LXYSIZ,LASTFP,LFDAT
3291      parameter (LARROW=1, LWIDTH=2, LWIDRE=6, LBAD=7,
3292     1  LVALS=9, LXYSIZ=LVALS+5, LASTFP=LXYSIZ+2,LFDAT=LBAD)
3293c          Parameter for various sizes.
3294      integer LBNDC, LBNDF, LBNDP, LBNDT, MAXSET
3295      parameter (LBNDC=128, LBNDF=32, LBNDP=4, LBNDT=64, MAXSET=20)
3296      double precision BORLOC(6), FILL(19), FP(LASTFP), OVLAP,
3297     1  PHYUSE(2,2), SETLIM(2,2), TLENH, TLENV, TICKS(4,6), TOPTS,
3298     2  VHLEN(2), XYBASE(MAXSET), XYLIM(2,MAXSET), XYU2PF(MAXSET)
3299      integer IERR1, IERR2, IERR3, IERR4, IOP1, IP(LASTIP), JSET(2),
3300     1  LENCAP(6), LENTXT(3,18), MANNO, MBORD(8,6), MFILL(4), NTEXT,
3301     2  NXYLIM(MAXSET)
3302      logical  KLIP(MAXSET), NOOUT, OPAQUE
3303      common / DPLOTB / BORLOC, FILL, FP, OVLAP, PHYUSE, SETLIM, TICKS,
3304     1  TLENH, TLENV, TOPTS, VHLEN, XYBASE, XYLIM, XYU2PF, IERR1,
3305     2  IERR2, IERR3, IERR4, IOP1, IP, JSET, LENCAP, LENTXT, MANNO,
3306     3  MBORD, NTEXT, NXYLIM, KLIP, MFILL, NOOUT, OPAQUE
3307c Locals
3308      integer I, IEARR(1), J, J1, J2, K, LCOPT(10:19), LOPT(20:31),
3309     1   LOTHER(33:39), LWARN(7), MACT1(5), MACT2(5), MACT3(2),
3310     2   MACT4(2), MACT5(7)
3311      character TXTCOP(1)*200, TXTOPT(1)*40
3312c Parameters for error messages
3313      integer MENTXT, MECONT, MERET, MEEMES, METEXT, MEFVEC
3314      parameter (MENTXT=23, MECONT=50, MERET=51, MEEMES=52, METEXT=53,
3315     1   MEFVEC=61)
3316c ********* Error message text ***************
3317c[Last 2 letters of Param. name]  [Text generating message.]
3318cAA DPLOT$B
3319cAB Warning -- Points provided are not being plotted.$E
3320cAC Warning -- Centering on x or y axis not allowed.$E
3321cAD Warning -- Too much space wasted at border $I.$E
3322cAE Warning -- Format number out of range.$E
3323cAF Warning -- Unknown format specification: $B
3324cAG Warning -- Caption doesn't have balanced {...} or $$...$$:$E
3325cAH Warning -- Caption in physical coordinates does not fit.$E
3326c   $
3327cAI DPLOT$B
3328cAJ Bad option character.$E
3329cAK Bad start of COPT option.$E
3330cAL Runaway in COPT, unbalanced (), [], or {}?$E
3331cAM Missing #?, $E
3332cAN File name or caption is empty.  $E
3333cAO Text inside (), {}, [], may contain at most $I chars.  $E
3334cAP [...] must contain 2 or 4 letters.$E
3335cAQ First position must be one of "tcbTCB".$E
3336cAR Second position must be one of "lcrLCR.$E
3337cAS Error in third/forth position of [...].$E
3338c   $
3339cAT DPLOT$B
3340cAU Bad option index.$E
3341cAV Option value is not an integer.$E
3342cAW Option value is too big to be an integer.$E
3343cAX Digit 10^0 of option 1 is too big.$E
3344cAY Type flag must be 0 or 1.$E
3345cAZ Polar coordinates (not implemented) or bad 10^2, 10^3 digit.$E
3346cBA Only digits 1 to 6 can be used for borders.$E
3347cBB Min/max on x or y specified twice.$E
3348cBC NY changed in middle of curve.$E
3349cBD Attempting to change data set without providing data.$E
3350cBE More than NY symbols.$E
3351cBF Bad value for symbol plotting.$E
3352cBG Digit 10^0 for option 19, must be < 5.$E
3353c   $
3354cBH DPLOT$B
3355cBI Not enough room for plot.$E
3356cBJ Unable to find unused I/O unit number in 10..100.$E
3357cBK Unable to open output file: $B
3358cBL Internal Error -- Adding point (in DPLOTF) without initialization.$E
3359cBM Internal Error -- N < -4 on call to DPLOTF.$E
3360cBN Internal Error -- N < 0 and not in initial state in DPLOTF.$E
3361cBO Internal Error -- S values must be increasing in DPLOTF.$E
3362      integer LTXTAA,LTXTAB,LTXTAC,LTXTAD,LTXTAE,LTXTAF,LTXTAG,LTXTAH,
3363     * LTXTAI,LTXTAJ,LTXTAK,LTXTAL,LTXTAM,LTXTAN,LTXTAO,LTXTAP,LTXTAQ,
3364     * LTXTAR,LTXTAS,LTXTAT,LTXTAU,LTXTAV,LTXTAW,LTXTAX,LTXTAY,LTXTAZ,
3365     * LTXTBA,LTXTBB,LTXTBC,LTXTBD,LTXTBE,LTXTBF,LTXTBG,LTXTBH,LTXTBI,
3366     * LTXTBJ,LTXTBK,LTXTBL,LTXTBM,LTXTBN,LTXTBO
3367      parameter (LTXTAA=  1,LTXTAB=  8,LTXTAC= 59,LTXTAD=109,LTXTAE=158,
3368     * LTXTAF=199,LTXTAG=242,LTXTAH=302,LTXTAI=  1,LTXTAJ=  8,
3369     * LTXTAK= 31,LTXTAL= 58,LTXTAM=102,LTXTAN=116,LTXTAO=150,
3370     * LTXTAP=207,LTXTAQ=243,LTXTAR=285,LTXTAS=326,LTXTAT=  1,
3371     * LTXTAU=  8,LTXTAV= 27,LTXTAW= 60,LTXTAX=103,LTXTAY=139,
3372     * LTXTAZ=166,LTXTBA=228,LTXTBB=273,LTXTBC=309,LTXTBD=341,
3373     * LTXTBE=396,LTXTBF=419,LTXTBG=451,LTXTBH=  1,LTXTBI=  8,
3374     * LTXTBJ= 35,LTXTBK= 86,LTXTBL=116,LTXTBM=184,LTXTBN=229,
3375     * LTXTBO=291)
3376      character MTXTAA(2) * (180)
3377      character MTXTAB(2) * (183)
3378      character MTXTAC(2) * (245)
3379      character MTXTAD(2) * (174)
3380      data MTXTAA/'DPLOT$BWarning -- Points provided are not being plott
3381     *ed.$EWarning -- Centering on x or y axis not allowed.$EWarning --$
3382     * Too much space wasted at border $I.$EWarning -- Format numbe','r$
3383     * out of range.$EWarning -- Unknown format specification: $BWarning
3384     * -- Caption doesn''t have balanced {...} or $$...$$:$EWarning -- C
3385     *aption in physical coordinates does not fit.$E '/
3386      data MTXTAB/'DPLOT$BBad option character.$EBad start of COPT optio
3387     *n.$ERunaway in COPT, unbalanced (), [], or {}?$EMissing #?, $EFile
3388     * name or caption is empty.  $EText inside (), {}, [], may contai',
3389     *'n at most $I chars.  $E[...] must contain 2 or 4 letters.$EFirst$
3390     * position must be one of "tcbTCB".$ESecond position must be one of
3391     * "lcrLCR.$EError in third/forth position of [...].$E'/
3392      data MTXTAC/'DPLOT$BBad option index.$EOption value is not an inte
3393     *ger.$EOption value is too big to be an integer.$EDigit 10^0 of opt
3394     *ion 1 is too big.$EType flag must be 0 or 1.$EPolar coordinates (n
3395     *ot implemented) or bad 10^2, 10^3 digit.$EOnly digits 1 to 6',' ca
3396     *n be used for borders.$EMin/max on x or y specified twice.$ENY cha
3397     *nged in middle of curve.$EAttempting to change data set without pr
3398     *oviding data.$EMore than NY symbols.$EBad value for symbol plottin
3399     *g.$EDigit 10^0 for option 19, must be < 5.$E'/
3400      data MTXTAD/'DPLOT$BNot enough room for plot.$EUnable to find unus
3401     *ed I/O unit number in 10..100.$EUnable to open output file: $BInte
3402     *rnal Error -- Adding point (in DPLOTF) without initiali','zation.$
3403     *EInternal Error -- N < -4 on call to DPLOTF.$EInternal Error -- N$
3404     * < 0 and not in initial state in DPLOTF.$EInternal Error -- S valu
3405     *es must be increasing in DPLOTF.$E'/
3406c ********* End of Error message text ***************
3407c
3408c                    123456789012345678901
3409      data TXTOPT / ' O.K. part of OPT:$BError part of OPT:$B' /
3410
3411      data LWARN / LTXTAB,LTXTAC,LTXTAD,LTXTAE,LTXTAF,LTXTAG,LTXTAH /
3412
3413      data LCOPT / LTXTAJ, LTXTAK, LTXTAL, LTXTAM, LTXTAN, LTXTAO,
3414     1   LTXTAP, LTXTAQ, LTXTAR, LTXTAS /
3415
3416      data LOPT / LTXTAU, LTXTAV, LTXTAW, LTXTAX, LTXTAY, LTXTAZ,
3417     1   LTXTBA, LTXTBB, LTXTBC, LTXTBD, LTXTBF, LTXTBG /
3418
3419      data LOTHER / LTXTBI, LTXTBJ, LTXTBK, LTXTBL, LTXTBM, LTXTBN,
3420     1   LTXTBO /
3421c                       1  2  3  4      5
3422      data MACT1 / MEEMES, 0, 0, 0, MERET /
3423      data MACT2 / MEEMES,47, 0, 0, MECONT /
3424      data MACT3 / METEXT, MECONT /
3425      data MACT4 / METEXT, MERET /
3426      data MACT5 / METEXT, MEFVEC, 0, METEXT, MEFVEC, 0, MERET /
3427c
3428c ************************ Start of Executable Code ********************
3429c
3430      if ((IERR .eq. 5) .or. (IERR .eq. 35)) MACT1(5) = MECONT
3431      IEARR(1) = IERR1
3432      if (IERR .le. 19) then
3433         if (IERR .le. 7) then
3434            MACT1(2) = 25
3435            MACT1(3) = IERR
3436            MACT1(4) = LWARN(IERR)
3437            call MESS(MACT1, MTXTAA, IEARR)
3438            go to 250
3439         else if (IERR .ge. 10) then
3440            MACT2(3) = IERR
3441            MACT2(4) = LCOPT(IERR)
3442            call MESS(MACT2, MTXTAB, IEARR)
3443         else
3444            go to 300
3445         end if
3446      else if (IERR .le. 32) then
3447         MACT2(3) = IERR
3448         MACT2(4) = LOPT(IERR)
3449         call MESS(MACT2, MTXTAC, IEARR)
3450         go to 100
3451      else
3452         MACT1(2) = 47
3453         MACT1(3) = IERR
3454         I = IERR
3455         if (I .gt. 35) I = I - 4
3456         if (I .gt. 39) go to 300
3457         MACT1(4) = LOTHER(I)
3458         call MESS(MACT1, MTXTAD, IEARR)
3459         go to 250
3460      end if
3461c                   Take care of COPT part of message.
3462      J1 = 1
3463      J2 = IERR3
3464      if (J2 .le. 0) J2 = IERR4
3465   10 TXTCOP(1)(1:20) = ' O.K. part of COPT: '
3466      if (IERR3 .le. 0) TXTCOP(1)(1:6) = 'Error '
3467      K = 21
3468   20 do 40 J = J1, J2
3469         TXTCOP(1)(K:K) = COPT(J:J)
3470         if (TXTCOP(1)(K:K) .eq. '$') then
3471            K = K + 1
3472            TXTCOP(1)(K:K) = '$'
3473         end if
3474         K = K + 1
3475         if (K .gt. 196) then
3476            TXTCOP(1)(K:K+1) = '$B'
3477            call MESS(MACT3, TXTCOP, IEARR)
3478            K = 1
3479            J1 = J + 1
3480            go to 20
3481         end if
3482   40 continue
3483      TXTCOP(1)(K:K+1) = '$E'
3484      if ((IERR3 .lt. 0) .or. ((IOP1 .le. 0) .and. (IERR3 .eq. 0))) then
3485         call MESS(MACT4, TXTCOP, IEARR)
3486         go to 200
3487      end if
3488      call MESS(MACT3, TXTCOP, IEARR)
3489      if (IERR3 .gt. 0) then
3490         IERR3 = 0
3491         J1 = J
3492         J2 = IERR4
3493         go to 10
3494      end if
3495c                   Take care of OPT part of message.
3496  100 MACT5(3) = IOP1 - 1
3497      MACT5(6) = -IERR2
3498      call DMESS(MACT5, TXTOPT, IEARR, OPT)
3499c
3500  200 IOP1 = -100 - IERR
3501      return
3502c                   Check for special case
3503  250 if (MACT1(5) .eq. MERET) go to 200
3504c                   Set up for output of format spec. or file name.
3505      MACT1(5) = MERET
3506      J1 = 1
3507      J2 = IERR1
3508      IERR3 = -1
3509      K = 1
3510      go to 20
3511c                   An internal error
3512  300 continue
3513C%%   puts( "Internal error in DPLOT, bad error index." );
3514C%%   close_units();
3515C%%   puts( "[Stop]" );
3516C%%   exit(0);
3517      stop 'Internal error in DPLOT, bad error index.'
3518      end
3519
3520      subroutine DPLOTF(N, S, X, Y)
3521c### Want to add provision for polar coordinates.
3522c
3523c  Selects points for plotting so as to get nice curves without using
3524c  too many points.
3525c
3526c N      Indicates action desired.  One must have provided a negative
3527c  value for N (to start a new curve) before supplying a positive value.
3528c   > 0   Number of points provided for plotting.
3529c   = 0   End of current curve (if any).
3530c   < 0   Start a new curve as follows:
3531c     = -1  Just providing pairs of points (X, Y).  X(1:2) give the
3532c           maximum and minimum value expecter for X with Y(1:2)
3533c           similarly defined, except for Y.
3534c     = -2  As for -2, except, providing X and Y as functions of S.
3535c           Values of S must be monotone increasing or monotone
3536c           decreasing.
3537c     = -3  As for -1, except the min and max values are limits and the
3538c           curve is to be clipped if it exceeds these limits.
3539c     = -4  As for -2, with the clipping as with -3.
3540c S()   Only used when the initial value for N = -2, -4, -22, and -24,
3541c       in which case it is the independent variable.
3542c X(), Y()  The point pairs being provided, in physical units.
3543c       If N < -10 gives the range of values for the independent
3544c       variable.
3545c
3546c When S is not provided, an internal value for S is constructed based
3547c on a polygonal approximation to the length of the curve.  In all cases
3548c X and Y are thought of as functions of S.  Points are selected in such
3549c a way that piecewise cubic approximations for X(S) and Y(S) are
3550c thought to be accurate to within TOL * max|X(S)| and TOL * max|Y(S)|
3551c respectively, where TOL is 0.01.
3552c
3553c ******************* External Reference *******************************
3554c
3555c DPLOTL is called for the final stage of outputting points.
3556c
3557c ******************* Variable Definitions *****************************
3558c
3559c DS     Array used to old S values for computing divided differences.
3560c DX     Array used to hold divided differences for X.
3561c DY     Array used to hold divided differences for Y.
3562c ERRMXL Previous estimate for ERRMAX.
3563c ERRMAX Estimate for largest error.
3564c GETS   Logical variable that is true if DPLOTF computes S.
3565c H      Current step size.  If < 0, then H has not yet been selected.
3566c HMAX   Maximum value to be considered for H.
3567c HMIN   Minimum value to be considered for H.
3568c I      Temporary index.
3569c I1     Starting index for loop processing new points.
3570c I2     Final index for loop processing new points.
3571c IKLIP  Index of input point that causes points to be processed due
3572c        to clipping.
3573c ILAST  Index into XI, YI arrays for last values to send out.
3574c J      Temporary index.
3575c K      Temporary index.
3576c KLIP   Used to indicate whether clipping (X or Y values out of bounds)
3577c        is active.
3578c    = 0    No checking being done for clipping.
3579c    =-1    Currently out of range, check for getting in range.
3580c    = 1    Currently in range, check for getting point out of range.
3581c    = 2    Got a point our of range in process of getting next one,
3582c           or processing the points up to the clipping point.
3583c    =-2    Initialize for clipping.
3584c KLIPS  If 0, the start of the data is not clipped, else if -1 it is.
3585c KORD   Parameter giving the degree assumed for the interpolating
3586c        polynomial.
3587c KORD1  = KORD + 1
3588c KORD2  = KORD + 2
3589c L      Temporary index.
3590c LOC    Array mapping index of selected point into SI, XI, YI arrays.
3591c LAST   Flag to be interpreted as follows.
3592c     -1  Not yet initialized.
3593c     >-1 Number of points in internal buffer ready for processing.
3594c MX     Parameter giving the maximum number of points that can be
3595c        examined at one time.
3596c N      Formal argument, see above.
3597c NI     Internal value for N.
3598c S      Formal argument, see above.
3599c S1     Value of S for which one is getting interpolated values.
3600c SI     Internal saved values for S.  (Either input values for S, or
3601c        ones that have been generated.
3602c TOL    Parameter giving requested relative accuracy in the
3603c        intepolation for X and Y.
3604c TOLLO  Low value for tolerance = TOL / 8.
3605c TP     Temporary real variable.
3606c TP1    Temporary real variable.
3607c TP2    Temporary real variable.
3608c X      Formal argument, see above.
3609c X1     Value interpolated for X(S1).
3610c XD     Temporary storage for difference between X values.
3611c XI     Internal saved values for X.
3612c XMAX   Interpolated values with X > XMAX cause clipping.  See N = -5
3613c        above.
3614c XMIN   As for XMAX, except for X < XMIN.
3615c YMAX   As for XMAX, except for value of Y.
3616c YMIN   As for YMAX, except for Y < YMIN.
3617c XSCAL  (Largest X - Smallest X) in the graph.
3618c Y      Formal argument, see above.
3619c Y1     Value interpolated for Y(S1).
3620c YD     Temporary storage for difference between Y values.
3621c YI     Internal saved values for Y.
3622c YSCAL  (Largest Y - Smallest Y) in the graph.
3623c
3624c ******************* Variable Declarations ****************************
3625c
3626      integer N
3627      double precision S(*), X(*), Y(*)
3628      integer I, I1, I2, IKLIP, ILAST, J, K, KLIP, KLIPS, KORD, KORD1,
3629     1    KORD2, L, LAST, LOC(4), MX, NI
3630      logical GETS
3631C++ Default KORD = 2
3632C++ Substitute for KORD below
3633      parameter (MX = 101, KORD=2)
3634      parameter (KORD1=KORD+1, KORD2=KORD+2)
3635      double precision DS(KORD2), DX(KORD2), DY(KORD2), ERRMAX, ERRMXL,
3636     1    H, HMAX, HMIN, S1, SI(0:MX), TOL, TOLLO, TP, TP1, TP2, X1, Y1,
3637     2    XD, YD, XI(MX), XMAX, XMIN, YI(MX), XSCAL, YMAX, YMIN, YSCAL
3638      parameter (TOL = 1.D-3)
3639      parameter (TOLLO = .25D0 * TOL)
3640      save DS, DX, DY, GETS, H, KLIP, KLIPS, LAST, SI, XI, YI, XMAX,
3641     1   XMIN, XSCAL, YMAX, YMIN, YSCAL
3642      data  SI(0), LAST / 0.D0, -1 /
3643      data KLIP, XMAX, YMAX / 0,  0.D0, 0.D0 /
3644c
3645c ******************* Start of Executable Code *************************
3646c
3647      NI = N
3648  100 if (LAST .eq. -1) then
3649c                         Initial State
3650         H = 0.D0
3651         if (NI .ge. 0) then
3652            if (NI .eq. 0) return
3653c                   Trying to add points without initialization
3654            call DPLOTE(40, S, ' ')
3655            return
3656         end if
3657         if (NI .lt. -4) then
3658c                             N < -4 on call to DPLOTF
3659            call DPLOTE(41, S, ' ')
3660            return
3661         end if
3662         LAST = 0
3663         XMIN = X(1)
3664         XMAX = X(2)
3665         YMIN = Y(1)
3666         YMAX = Y(2)
3667         XSCAL = max(abs(XMIN), abs(XMAX))
3668         YSCAL = max(abs(XMIN), abs(XMAX))
3669         KLIP = 0
3670         if (NI .lt. -2) then
3671            KLIP = -2
3672            NI = NI + 2
3673         end if
3674         GETS = NI .eq. -1
3675         return
3676      else if (NI .lt. 0) then
3677c                         N < 0 and not in initial state
3678         call DPLOTE(42, S, ' ')
3679         return
3680      end if
3681      IKLIP = 0
3682      I1 = 1
3683  380 if (KLIP .eq. -2) then
3684         KLIP = 1
3685         KLIPS = 0
3686         if ((X(I1) .lt. XMIN) .or. (X(I1) .gt. XMAX) .or.
3687     1      (Y(I1) .lt. YMIN) .or. (Y(I1) .gt. YMAX)) then
3688            KLIP = -1
3689            KLIPS = -1
3690         end if
3691      end if
3692c                Add points to list
3693  400 I2 = min(NI, MX - LAST)
3694      do 420 I = I1, I2
3695         if (KLIP .ne. 0) then
3696c          Check clipping -- First check if in range
3697            if ((X(I) .lt. XMIN) .or. (X(I) .gt. XMAX) .or.
3698     1         (Y(I) .lt. YMIN) .or. (Y(I) .gt. YMAX)) then
3699c                         Current point is out of range.
3700               if (KLIP .eq. -1) then
3701c                     We are getting points that are out of range.
3702                  LAST = 0
3703               else
3704c      We have got a point out of range after being in range.
3705                  if (LAST + KLIPS .eq. 1) then
3706c               No points used if only one is inside the region.
3707                     KLIP = -1
3708                     LAST = 0
3709                     KLIPS = -1
3710                  else if (KLIP .eq. 1) then
3711c                     Flag that this is the last I for the current set.
3712                     KLIP = 2
3713                     IKLIP = I
3714                  end if
3715               end if
3716            else if (KLIP .ne. 1) then
3717c                    Just got a point in range
3718               if (KLIP .eq. -1) then
3719c                     Flag that we are now getting points in range.
3720                  KLIP = 1
3721               end if
3722            end if
3723         end if
3724c                          End of test for clipping
3725         LAST = LAST + 1
3726         XI(LAST) = X(I)
3727         YI(LAST) = Y(I)
3728         if (GETS) then
3729            if (LAST .eq. 1) then
3730               SI(1) = 0.D0
3731            else
3732               XD = abs(XI(LAST) - XI(LAST-1))
3733               YD = abs(YI(LAST) - YI(LAST-1))
3734               if (XD .lt. YD) then
3735                  SI(LAST) = SI(LAST-1) + YD * sqrt(1.D0 + (XD/YD)**2)
3736               else if (XD .eq. 0.D0) then
3737c                                      Skip the input
3738                  LAST = LAST - 1
3739               else
3740                  SI(LAST) = SI(LAST-1) + XD * sqrt(1.D0 + (YD/XD)**2)
3741               end if
3742            end if
3743         else
3744            SI(LAST) = S(I)
3745            if (LAST .ne. 1) then
3746               if (SI(LAST) .eq. SI(LAST-1)) then
3747                  LAST = LAST - 1
3748               else if (SI(LAST) - SI(LAST-1) .lt. 0.D0) then
3749c                                            S values must be increasing
3750                  call DPLOTE(43, S, ' ')
3751                  return
3752               end if
3753            end if
3754         end if
3755         if (KLIP .eq. 2) go to 430
3756  420 continue
3757      I1 = I
3758      if (NI .gt. 0) then
3759         if (LAST .lt. MX) return
3760      else
3761         if (LAST .eq. 0) return
3762      end if
3763c                            Code to take care of clipping
3764  430 if (KLIP .ne. 0) then
3765c                          If LAST is < 3 just skip the output.
3766         if (LAST .lt. 3) go to 880
3767         if ((KLIPS .lt. 0) .or. (KLIP .gt. 1)) then
3768            if (KLIPS .lt. 0) then
3769c Setup to fit quadratic to first three points to get replacement value.
3770               do 440 J = 1, 3
3771                  DS(J) = SI(4-J)
3772                  DX(J) = XI(4-J)
3773                  DY(J) = YI(4-J)
3774  440          continue
3775               I2 = 1
3776               go to 470
3777            end if
3778c Setup to fit quadratic to last three points to get replacement value.
3779  450       do 460 J = 1, 3
3780               DS(J) = SI(LAST+J-3)
3781               DX(J) = XI(LAST+J-3)
3782               DY(J) = YI(LAST+J-3)
3783  460       continue
3784            I1 = I + 1
3785            I2 = LAST
3786            KLIP = -1
3787c Get divided differences, and interpolated values for boundary values.
3788  470       do 490 K = 1, 2
3789               do 480 J = 1, 3 - K
3790                  DX(J) = (DX(J+1) - DX(J)) / (DS(J+K) - DS(J))
3791                  DY(J) = (DY(J+1) - DY(J)) / (DS(J+K) - DS(J))
3792  480          continue
3793  490       continue
3794c At this point either DX(3), or DY(3) is out of range, and we would
3795c like to replace the "worst" one with a value on the boundary.
3796            DS(2) = DS(2) - DS(3)
3797            DS(1) = DS(1) - DS(3)
3798            X1 = 0.D0
3799            Y1 = 0.D0
3800            if ((DY(3) .lt. YMIN) .or. (DY(3) .gt. YMAX)) then
3801c    Get TP and TP1 for quadratic:  DY(1)*s^2 - TP1 * s + TP = 0
3802c    Where s is the increment from DS(3)
3803               TP = -YMIN
3804               if (DY(3) .gt. YMAX) TP = -YMAX
3805               YD = TP
3806               TP = TP + DY(3)
3807               TP1 = DY(2) - DY(1) * DS(2)
3808c                     Get Y1 = smallest root
3809               TP2 = TP1**2 - 4.D0*DY(1)*TP
3810               if (TP2 .ge. 0.D0) then
3811c                     Have real roots, else just ignore problem
3812                  Y1 = -2.D0 * TP / (TP1 + sign(sqrt(TP2), TP1))
3813                  if (Y1 * (Y1 - DS(2)) .gt. 0.D0) then
3814c                 Smallest root not in desired interval try the big one.
3815                     Y1 = TP / Y1
3816                     if (Y1 * (Y1 - DS(2)) .gt. 0.D0) Y1 = 0.D0
3817                  end if
3818               end if
3819            end if
3820            if ((DX(3) .lt. XMIN) .or. (DX(3) .gt. XMAX)) then
3821c                                             Same as above except for X
3822               TP = -XMIN
3823               if (DX(3) .gt. XMAX) TP = -XMAX
3824               XD = TP
3825               TP = TP + DX(3)
3826               TP1 = DX(2) - DX(1) * DS(2)
3827c                     Get X1 = smallest root
3828               TP2 = TP1**2 - 4.D0*DX(1)*TP
3829               if (TP2 .ge. 0.D0) then
3830c                     Have real roots, else just ignore problem
3831                  X1 = -2.D0 * TP / (TP1 + sign(sqrt(TP2), TP1))
3832                  if (X1 * (X1 - DS(2)) .gt. 0.D0) then
3833c                 Smallest root not in desired interval try the big one.
3834                     X1 = TP / X1
3835                     if (X1 * (X1 - DS(2)) .gt. 0.D0) X1 = 0.D0
3836                  end if
3837               end if
3838            end if
3839            TP = Y1
3840c                    Pick value that is nearest middle of region
3841            if (DS(2) * (TP - X1) .lt. 0.D0) then
3842               TP = X1
3843               XI(I2) = -XD
3844c                Insure that high difference doesn't give a bulge.
3845               TP1 = (TP - DS(2)) * DY(1)
3846               if (DY(2) .lt. 0.D0) then
3847                  TP1 = min(TP1, -.75D0*DY(2))
3848               else
3849                  TP1 = max(TP1, -.75D0*DY(2))
3850               end if
3851               YI(I2) = DY(3) + TP * (DY(2) + TP1)
3852            else
3853               YI(I2) = -YD
3854c                Insure that high difference doesn't give a bulge.
3855               TP1 = (TP - DS(2)) * DX(1)
3856               if (DX(2) .lt. 0.D0) then
3857                  TP1 = min(TP1, -.75D0*DX(2))
3858               else
3859                  TP1 = max(TP1, -.75D0*DX(2))
3860               end if
3861               XI(I2) = DX(3) + TP * (DX(2) + TP1)
3862            end if
3863            SI(I2) = SI(I2) + TP
3864            if (KLIPS .lt. 0) then
3865               KLIPS = 0
3866               if (KLIP .gt. 1) go to 450
3867            end if
3868         end if
3869      end if
3870      if (H .ne. 0.D0) then
3871         I = KORD1
3872         J = KORD1
3873         go to 800
3874      end if
3875c####
3876c#### If polar coodinates, this is place to do the transformation.
3877c#### Remember last point transformed.  Think we don't want to touch
3878c#### points much beyond the half way point until we know we have
3879c#### seen the end.  Need to recompute s, x, and y.
3880c####
3881c                      Need to get the starting H
3882      ERRMXL = -1.D0
3883c            Process the points -- First get the starting step size
3884      HMAX = .25D0 * (SI(LAST) - SI(1))
3885      HMIN = 0.D0
3886      H = .25D0 * (SI(min(LAST,8)) - SI(1))
3887  520 TP = SI(1)
3888      I = 0
3889      J = 1
3890      go to 550
3891c            Just selected a new point.
3892  540 if (J .gt. LOC(I) + 1) J = J - 1
3893  550 I = I + 1
3894c             I is index for points we are planning to test
3895c             J is index from which we get the points.
3896      LOC(I) = J
3897      if (I .lt. KORD1) then
3898         TP = TP + H
3899         do 600 J = J + 1, LAST
3900c                                Save and process next if gone too far
3901            if (SI(J) .gt. TP) go to 540
3902  600    continue
3903c                                Didn't get a full set of points.
3904         J = LAST
3905         if (LOC(I) .ne. J) then
3906c                                Take the last point if we can.
3907            I = I + 1
3908            LOC(I) = J
3909         end if
3910         if (I .ne. KORD1) then
3911            if (J .gt. I) then
3912c                    We could have got more in the initial set.
3913               HMAX = .875D0 * H
3914               H = .5D0 * (H + HMIN)
3915               go to 520
3916            end if
3917            go to 750
3918         end if
3919      end if
3920c                   Check if error is about right
3921      do 630 J = 1, KORD1
3922         K = LOC(J)
3923         DS(J) = SI(K)
3924         DX(J) = XI(K)
3925         DY(J) = YI(K)
3926  630 continue
3927c                  Get divided differences
3928      do 650 K = 1, KORD
3929         do 640 J = 1, KORD1 - K
3930            DX(J) = (DX(J+1) - DX(J)) / (DS(J+K) - DS(J))
3931            DY(J) = (DY(J+1) - DY(J)) / (DS(J+K) - DS(J))
3932  640    continue
3933  650 continue
3934c               Check accuracy -- First for the starting stepsize.
3935      ERRMAX = 0.D0
3936      J = 2
3937      TP = SI(LAST)
3938      do 670 K = 2, LAST
3939         if (K .eq. LOC(J)) then
3940            if (J .lt. KORD1) then
3941               J = J + 1
3942            else
3943               TP = SI(K) + H
3944            end if
3945         else
3946            S1 = SI(K)
3947            if (S1 .gt. TP) go to 680
3948C++ CODE for KORD == 3 is inactive
3949C            X1 = DX(4) + (S1 - DS(4)) * (DX(3) + (S1 - DS(3)) *
3950C     1         (DX(2) + (S1 - DS(2)) * DX(1)))
3951C            ERRMAX = max(ERRMAX, abs(X1 - XI(K)) / XSCAL)
3952C            Y1 = DY(4) + (S1 - DS(4)) * (DY(3) + (S1 -  DS(3)) *
3953C     1                 (DY(2) + (S1 - DS(2)) * DY(1)))
3954C            ERRMAX = max(ERRMAX, abs(Y1 - YI(K)) / YSCAL)
3955C++ CODE for KORD == 2 is active
3956            X1 = DX(3) + (S1 - DS(3)) * (DX(2) + (S1 - DS(2))*DX(1))
3957            ERRMAX = max(ERRMAX, abs(X1 - XI(K)) / XSCAL)
3958            Y1 = DY(3) + (S1 - DS(3)) * (DY(2) + (S1 - DS(2))*DY(1))
3959            ERRMAX = max(ERRMAX, abs(Y1 - YI(K)) / YSCAL)
3960C++ END
3961         end if
3962  670 continue
3963  680 if (ERRMAX .eq. ERRMXL) HMIN = H
3964      ERRMXL = ERRMAX
3965      if (ERRMAX .gt. TOL) then
3966         if (H .gt. HMIN) then
3967            HMAX = .857D0 * H
3968            H = max(HMIN, H * sqrt(sqrt(.5D0 * TOL / ERRMAX)))
3969            go to 520
3970         end if
3971      else if (ERRMAX .lt. TOLLO) then
3972         if (ERRMAX .ne. 0.D0) then
3973            if (H .lt. HMAX) then
3974               HMIN = 1.125D0 * H
3975               H = min(HMAX, H * sqrt(sqrt(.5D0 * TOL / ERRMAX)))
3976               go to 520
3977            end if
3978         end if
3979         if ((NI .gt. 0) .and. (LOC(KORD1) .ne. KORD1)) then
3980            K = 0
3981            do 690 L = 1, I
3982               J = LOC(L)
3983               K = K + 1
3984               XI(K) = XI(J)
3985               YI(K) = YI(J)
3986               SI(K) = SI(J)
3987  690       continue
3988c                   Set up to get more points before output.
3989            do 710 K = K+1, LAST + K - J
3990               J = J + 1
3991               XI(K) = XI(J)
3992               YI(K) = YI(J)
3993               SI(K) = SI(J)
3994  710       continue
3995            LAST = K - 1
3996c                    Flag that we didn't see enough points.
3997            H = 0.D0
3998            if (I1 .gt. NI) return
3999            go to 400
4000         end if
4001      end if
4002c              Shift data to output place.
4003  750 do 760 K = 1, I
4004         J = LOC(K)
4005         XI(K) = XI(J)
4006         YI(K) = YI(J)
4007         SI(K) = SI(J)
4008  760 continue
4009c             Get rest of data, checking accuracy as we go.
4010  800 L = J
4011      TP = SI(I) + .3333333D0 * (SI(I) - SI(I-KORD))
4012      TP1 = 1.D0
4013  830 if (J .lt. LAST) then
4014         J = J + 1
4015         S1 = SI(J)
4016         if (S1 .gt. TP) TP1 = ((S1 - SI(I)) / (TP - SI(I)))**KORD1
4017         if (KORD .eq. 3) then
4018            X1 = DX(4) + (S1 - DS(4)) * (DX(3) + (S1 - DS(3)) *
4019     1         (DX(2) + (S1 - DS(2)) * DX(1)))
4020            Y1 = DY(4) + (S1 - DS(4)) * (DY(3) + (S1 -  DS(3)) *
4021     1                 (DY(2) + (S1 - DS(2)) * DY(1)))
4022         else if (KORD .eq. 2) then
4023            X1 = DX(3) + (S1 - DS(3)) * (DX(2) + (S1 - DS(2))*DX(1))
4024            Y1 = DY(3) + (S1 - DS(3)) * (DY(2) + (S1 - DS(2))*DY(1))
4025         end if
4026         ERRMAX = TP1 * max(abs(X1-XI(J))/XSCAL, abs(Y1-YI(J))/YSCAL)
4027         if (ERRMAX .le. TOL) go to 830
4028         if (J .gt. L+1) J = J - 1
4029         I = I + 1
4030c                          Save data
4031         SI(I) = SI(J)
4032         XI(I) = XI(J)
4033         YI(I) = YI(J)
4034c                          Update the differences
4035         do 850 L = 1, KORD
4036            DS(L) = DS(L+1)
4037            DX(L) = DX(L+1)
4038            DY(L) = DY(L+1)
4039  850    continue
4040         DS(KORD1) = SI(I)
4041         DX(KORD1) = XI(I)
4042         DY(KORD1) = YI(I)
4043         do 870 L = KORD, 1, -1
4044            DX(L) = (DX(L+1) - DX(L)) / (DS(KORD1) - DS(L))
4045            DY(L) = (DY(L+1) - DY(L)) / (DS(KORD1) - DS(L))
4046  870    continue
4047         go to 800
4048      end if
4049      ILAST = I - KORD1
4050      if (L .lt. J) then
4051c                         Save last point if not saved yet.
4052         I = I + 1
4053         SI(I) = SI(J)
4054         XI(I) = XI(J)
4055         YI(I) = YI(J)
4056      end if
4057  880 if (KLIP .eq. -1) then
4058         if (I .gt. 1) then
4059            ILAST = I
4060         else
4061            ILAST = 0
4062         end if
4063      else if (NI .eq. 0) then
4064         ILAST = I
4065      end if
4066c            Get output for points I = 1 to I = ILAST
4067      if (ILAST .ne. 0) call DPLOTL(ILAST, XI, YI)
4068      if (IKLIP .ne. 0) then
4069c              Continue with point causing clipping.
4070         I1 = IKLIP
4071         LAST = 0
4072         KLIP = -2
4073         call DPLOTL(-1, XI, YI)
4074         go to 380
4075      end if
4076      if (NI .eq. 0) then
4077c                    End of a data set, get into initial state.
4078         LAST = -1
4079         call DPLOTL(0, XI, YI)
4080         go to 100
4081      end if
4082      LAST = 0
4083      do 900 J = ILAST+1, I
4084c              Set up to start over.
4085         LAST = LAST + 1
4086         SI(LAST) = SI(J)
4087         XI(LAST) = XI(J)
4088         YI(LAST) = YI(J)
4089  900 continue
4090      if (I1 .gt. NI) return
4091      go to 400
4092      end
4093
4094
4095      subroutine DPLOTN(VAL, IKASE, XYPOS)
4096c For output of numeric labels, F. T. Krogh, JPL, July 18, 1997.
4097c
4098c ************************* Arguments passed in ************************
4099c
4100c VAL    Value to be printed.
4101c IKASE  The label case.  See comments for LENTXT in DPLOT above.  If
4102c    < 0, the value provided is the log10 of the number.
4103c OPAQUE .true. if the label is to go into an opaque box.
4104c XYPOS  (Physical coordinate of the absicssa, Etc. for coordinate)
4105c FMTNUM See main comments in DPLOT.
4106c LENTXT Length of various strings in FMTNUM and TXTDEF.
4107c
4108c ************************* Usage of internal variables ****************
4109c
4110c ALIGN  Alignment for the label -- passed into DPLOT4.
4111c C      Temporary character*1 variable.
4112c DOL    =.true. if a "$" has been output, =.false. otherwise.
4113c DIG    Character string for storage of digits.
4114c EPS1   1 + 4 * machine eps. -- Used to avoid some round off problems.
4115c FMTSAV Saved value of string used to define the last format.
4116c HADJ   Used to adjust for different hoizontal positioning when testing
4117c        for overlap of numeric labels and drawing opaque boxes.
4118c I      Temorary index.
4119c INTVAL Equivalenced to: LEXP, NPTSIZ, MINDIG, NAFTU, LZERO
4120c K      Temorary index.
4121c KTEN   integer part of log10(|VAL|).  Also used for option values.
4122c LEXP   Amount to bias in favor of exponent.  > 0 favors exponents, <
4123c        discourages them.  LEXP = 4 always uses exponents.
4124c KASE   abs(IKASE)
4125c LKASE  Last value for KASE
4126c NTEXT*  Index of last character deposited in TEXT.
4127c LTEXTF Length of the last format def. processed.  -1 initially.
4128c LZERO  Number of digits that must precede the decimal point.
4129c MAXDIG Maximum number of digits printed.
4130c MINDIG Minimum number of digits that need to be output.
4131c NAFT   Number of digits required after the decimal point
4132c NCHAR0 Integer value associated with a '0', i.e. ichar('0').
4133c NDIG   Number of characters stored in DIG.
4134c NEEDD  Is .true. if the number must contain a decimal point.
4135c NLBND  Lower bounds for options: X, F, D, A, and B.  These options
4136c        define:
4137c    .   Always print a decimal point.
4138c   Fn    Fontsize in points.
4139c   Dn    Number of significant digits which must be printed.
4140c   An    Number of digits which are required after the decimal point.
4141c   Bn    Number of digits which are required before the decimal point,
4142c   Xn    0 < n < 10,  bias for selecting the exponent notation.  If n
4143c        is not zero, it is replaced with n-5.  The exponent notation is
4144c        used if there are 4-(final value of n) or more zeros that are
4145c        serving as place holders, else the usual format is used.  Note
4146c        that with an input n of 9, which is converted to n=4, there
4147c        will always be at least 0 zeros, and exponent notation is used.
4148c NPTSIZ Default point size for this kind of label.
4149c NUBND  Upper bounds for options: X, F, D, A, and B.
4150c OVLAP  Estimated right end of last number with KASE = 1, 2, or 5.
4151c PTSIZ  Real value of NPTSIZ.
4152c TEXT   The final output TEXT sent to DPLOT4.
4153c TLENH  Estimated space in units of space required by a single digit.
4154c        Later the horizontal space required in points.
4155c TLENV  Estimated vertical space in points.
4156c V      Initially VAL, then |V|, then contains the tail of V, i.e.
4157c        digits left to be output.
4158c
4159c ************************ Variable Declarations ***********************
4160c
4161c Common
4162c  For DPLOT0
4163      double precision ARRLEN, PXO, PXSIZE, PYO, PYSIZE
4164C++ CODE for ~.C. is active
4165      integer IOFIL, IPLOT, KURPEN, LASPEN
4166      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
4167     1   IOFIL, IPLOT, KURPEN, LASPEN
4168C++ CODE for .C. is inactive
4169C      integer IPLOT, KURPEN, LASPEN
4170C      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
4171C     1   IPLOT, KURPEN, LASPEN
4172C++ END
4173      save /DPLOTD/
4174c
4175c         Parameter pointers for integers in IP.
4176      integer NEXT, INTERP, LCOOX,LCOOY,LXLINE,LXBORD,LYBORD, LTYPE,
4177     1  KSET, LTANNO, LPEN, NBORD, LYDIM, LNY, LDEBUG,
4178     2  LASTIP
4179      parameter (NEXT=1, INTERP=2, LCOOX=3, LCOOY=4, LXLINE=5,
4180     1  LXBORD=6, LYBORD=7, LTYPE=8, KSET=9, LTANNO=10, LPEN=13,
4181     2  NBORD=14, LYDIM=15, LNY=16, LDEBUG=18, LASTIP=LDEBUG)
4182c          Parameter pointers for floats in FP.
4183      integer LARROW,LWIDTH,LWIDRE,LBAD,LVALS,LXYSIZ,LASTFP,LFDAT
4184      parameter (LARROW=1, LWIDTH=2, LWIDRE=6, LBAD=7,
4185     1  LVALS=9, LXYSIZ=LVALS+5, LASTFP=LXYSIZ+2,LFDAT=LBAD)
4186c          Parameter for various sizes.
4187      integer LBNDC, LBNDF, LBNDP, LBNDT, MAXSET
4188      parameter (LBNDC=128, LBNDF=32, LBNDP=4, LBNDT=64, MAXSET=20)
4189      double precision BORLOC(6), FILL(19), FP(LASTFP), OVLAP,
4190     1  PHYUSE(2,2), SETLIM(2,2), TLENH, TLENV, TICKS(4,6), TOPTS,
4191     2  VHLEN(2), XYBASE(MAXSET), XYLIM(2,MAXSET), XYU2PF(MAXSET)
4192      integer IERR1, IERR2, IERR3, IERR4, IOP1, IP(LASTIP), JSET(2),
4193     1  LENCAP(6), LENTXT(3,18), MANNO, MBORD(8,6), MFILL(4), NTEXT,
4194     2  NXYLIM(MAXSET)
4195      logical  KLIP(MAXSET), NOOUT, OPAQUE
4196      common / DPLOTB / BORLOC, FILL, FP, OVLAP, PHYUSE, SETLIM, TICKS,
4197     1  TLENH, TLENV, TOPTS, VHLEN, XYBASE, XYLIM, XYU2PF, IERR1,
4198     2  IERR2, IERR3, IERR4, IOP1, IP, JSET, LENCAP, LENTXT, MANNO,
4199     3  MBORD, NTEXT, NXYLIM, KLIP, MFILL, NOOUT, OPAQUE
4200c
4201      character FMTNUM(17)*(LBNDF), CAPTIO(6)*(LBNDC), POS*68, TEXT*280,
4202     1    TXTDEF(18)*(LBNDT)
4203      common / DPLOTC / FMTNUM, CAPTIO, POS, TEXT, TXTDEF
4204      save /DPLOTB/, /DPLOTC/
4205c Locals
4206      double precision VAL, XYPOS(2)
4207      integer   IKASE
4208      character ALIGN*2
4209      external  D1MACH
4210      double precision D1MACH
4211      double precision EPS1, HADJ(3), PTSIZ, V
4212      integer   I, INTVAL(5), K, KASE, KTEN, LEXP, LKASE, LTEXTF, LZERO,
4213     1   MAXDIG,  MINDIG, NAFT, NCHAR0, NDIG, NLBND(5), NPTSIZ, NUBND(5)
4214      logical DOL, NEEDD
4215      character C, DIG*40, FMTSAV*20
4216      equivalence (INTVAL(1), LEXP), (INTVAL(2), NPTSIZ),
4217     1  (INTVAL(3), MINDIG), (INTVAL(4), NAFT), (INTVAL(5), LZERO)
4218      save EPS1, LTEXTF, LKASE, MAXDIG, NCHAR0, NEEDD
4219c Save statement below, instead of just putting INTVAL above, is to get
4220c around a bug in the HP Exepmlar Fortran 77 compiler.
4221      save LEXP, NPTSIZ, MINDIG, NAFT, LZERO
4222c
4223c Weird stuff to take care of "\" being treated as an escape character
4224c on SGI Fortran compilers
4225      character BTIMES*7
4226C++ CODE for ~.C. is active
4227      character BSLAS1*(*), BSLASH
4228      parameter (BSLAS1 = '\\')
4229      parameter (BSLASH = BSLAS1(1:1))
4230c
4231      parameter (BTIMES=BSLASH//'times ')
4232C++ CODE for .C. is inactive
4233C      parameter (BTIMES='\times ')
4234C++END
4235c
4236      data LTEXTF, LKASE / -2, -1 /
4237c                  X   F   D   A  B
4238      data NLBND / 0,  5,  1,  0, 0 /
4239      data NUBND / 9, 30, 20, 20, 1 /
4240c                   l     c     r
4241      data HADJ / 0.D0, .5D0, 1.D0 /
4242c
4243c ********************** Start of Executable Code **********************
4244c
4245c     Alignment is in ALIGN
4246      KASE = abs(IKASE)
4247C%%   memcpy(align, dplotc.pos+kase*4 - 4, (size_t)2);
4248      ALIGN = POS(4*KASE-3:4*KASE-2)
4249c                    Take care of the format.
4250      if (LTEXTF .eq. LENTXT(1, KASE)) go to 100
4251      if (LTEXTF .eq. -2) then
4252c                             Get environmental parameters
4253         V = D1MACH(4)
4254         MAXDIG = -log10(V)
4255         EPS1 = 1.D0 + 8.D0 * V
4256         NCHAR0 = ichar('0')
4257      end if
4258c                         Process the format
4259      LTEXTF = LENTXT(1, KASE)
4260c                         Set the default values.
4261      LZERO = 0
4262      LEXP = 0
4263      MINDIG = 1
4264      NAFT = 0
4265      NPTSIZ = 9
4266      NEEDD = .false.
4267      if (LTEXTF .gt. 0) then
4268C%%      memcpy(fmtsav, dplotc.fmtnum[kase-1], (size_t)ltextf);
4269         FMTSAV(1:LTEXTF) = FMTNUM(KASE)(1:LTEXTF)
4270         K = 0
4271   20    K = K + 1
4272   30    if (K .lt. LTEXTF) then
4273c                      12345678901
4274            I = index('.XxFfDdAaBb', FMTSAV(K:K))
4275            if (I .ne. 0) then
4276               if (I .eq. 1) then
4277                  NEEDD = .true.
4278                  go to 20
4279               end if
4280c                      Get the following number
4281               KTEN = 0
4282   40          K = K + 1
4283               if (K .le. LTEXTF) then
4284                  C = FMTSAV(K:K)
4285                  if ((C .ge. '0') .and. (C .le. '9')) then
4286                     KTEN = 10*KTEN + ichar(C) - NCHAR0
4287                     go to 40
4288                  end if
4289               end if
4290               if (KTEN .ne. 0) then
4291c                              Want something other than the default.
4292                  I = I / 2
4293                  if ((KTEN.lt.NLBND(I)) .or. (KTEN.gt.NUBND(I))) then
4294c             Print error message, ignore the option
4295c                                             Format number out of range
4296                     call DPLOTE(4, XYPOS, ' ')
4297                  else
4298                     INTVAL(I) = KTEN
4299                     if (I .eq. 1) LEXP = KTEN - 5
4300                  end if
4301               end if
4302               go to 30
4303            else
4304c               Unknown format specification
4305               IERR1 = K
4306C%%            dplote( 5, xypos, fmtsav );
4307               call DPLOTE(5, XYPOS, FMTSAV(1:K))
4308            end if
4309         end if
4310      end if
4311
4312c          Convert value to string
4313  100 TLENH = 0.D0
4314      V = VAL
4315      DOL = .false.
4316      NTEXT = 0
4317      if (IKASE .lt. 0) then
4318         NDIG = 1
4319         KTEN = nint(V)
4320         DIG(1:1) = '1'
4321      else
4322         if (V .eq. 0.D0) then
4323            KTEN = 0
4324         else
4325            if (V .lt. 0.D0) then
4326c                             Output the "-" sign
4327               NTEXT = NTEXT + 2
4328               TEXT(NTEXT-1:NTEXT) = '$-'
4329               TLENH = 1.2D0
4330               DOL = .true.
4331               V = -V
4332            end if
4333c Boost up a tiny bit so things close to integers come out as integers.
4334            V = EPS1 * V
4335            KTEN = log10(V)
4336            if (V .lt. 1.D0) KTEN = KTEN - 1
4337         end if
4338         V = V * 10.D0 ** (-KTEN)
4339         NDIG = 0
4340  120    if (NDIG .lt. MINDIG) then
4341  130       NDIG = NDIG + 1
4342            DIG(NDIG:NDIG) = char(NCHAR0 + int(V))
4343            V = 10.D0 * mod(V, 1.D0)
4344            if ((V .gt. 1.D-2) .and. (NDIG .lt. MAXDIG)) go to 130
4345            if (KTEN - NDIG .le. 2 - LEXP) then
4346c                NDIG - KTEN - 1  is number of digits after the decimal.
4347               if (NDIG - KTEN .le. NAFT) go to 120
4348            end if
4349         end if
4350      end if
4351c At this point the number requires NDIG significant digits.
4352      if ((KTEN .lt. -3 + LEXP) .or. (KTEN - NDIG .gt. 2 - LEXP)) then
4353c                                           Use the exponent form
4354         if (.not. DOL) then
4355            DOL = .true.
4356            NTEXT = NTEXT + 1
4357            TEXT(NTEXT:NTEXT) = '$'
4358         end if
4359         if ((NDIG .ne. 1) .or. (DIG(1:1) .ne. '1')) then
4360            NTEXT = NTEXT + 1
4361            TLENH = TLENH + dble(NDIG)
4362            TEXT(NTEXT:NTEXT) = DIG(1:1)
4363            if (NDIG .gt. 1) then
4364               TLENH = TLENH + .4D0
4365               TEXT(NTEXT+1:NTEXT+1) = '.'
4366C%%           memcpy(dplotc.text+dplotb.ntext+1,dig+1,(size_t)(ndig-1));
4367               TEXT(NTEXT+2:NTEXT+NDIG) = DIG(2:NDIG)
4368            end if
4369            NTEXT = NTEXT + NDIG + 7
4370            TEXT(NTEXT-6:NTEXT) = BTIMES
4371            TLENH = TLENH + 1.4
4372         end if
4373         TEXT(NTEXT+1:NTEXT+4) = '10^{'
4374         TLENH = TLENH + 2.D0
4375         NTEXT = NTEXT + 4
4376         if (KTEN .lt. 0) then
4377            NTEXT = NTEXT + 1
4378            TEXT(NTEXT:NTEXT) = '-'
4379            KTEN = -KTEN
4380            TLENH = TLENH + 1.2D0
4381         end if
4382         K = 10
4383  140    if (K .le. KTEN) then
4384            K = 10 * K
4385            go to 140
4386         end if
4387  150    K = K / 10
4388         if (K .ne. 0) then
4389c                          Numbers on the exponent.
4390            TLENH = TLENH + .75D0
4391            I = KTEN / K
4392            NTEXT = NTEXT + 1
4393            TEXT(NTEXT:NTEXT) = char(NCHAR0 + I)
4394            KTEN = KTEN - 10 * I
4395            go to 150
4396         end if
4397         NTEXT = NTEXT + 1
4398         TEXT(NTEXT:NTEXT) = '}'
4399      else
4400c                                             Numbers without exponents
4401         if (KTEN .lt. 0) then
4402c                                             Number is < 1
4403c                    K introduced here due to bug in Lahey compiler.
4404            do 160 K = NTEXT+1, NTEXT + LZERO
4405               TLENH = TLENH + 1.D0
4406               TEXT(K:K) = '0'
4407  160       continue
4408            NTEXT = NTEXT + LZERO + 1
4409            TEXT(NTEXT:NTEXT) = '.'
4410            TLENH = TLENH + .4D0
4411            do 170 K = NTEXT+1, NTEXT - KTEN - 1
4412               TLENH = TLENH + 1.D0
4413               TEXT(K:K) = '0'
4414  170       continue
4415            NTEXT = NTEXT - KTEN
4416C%%         memcpy(dplotc.text+dplotb.ntext-1, dig, (size_t)ndig);
4417            TEXT(NTEXT:NTEXT+NDIG-1) = DIG(1:NDIG)
4418            NTEXT = NTEXT + NDIG - 1
4419         else
4420c                                             Number is >= 1.
4421            K = min(NDIG, KTEN+1)
4422C%%         memcpy(dplotc.text+dplotb.ntext, dig, (size_t)k);
4423            TEXT(NTEXT+1:NTEXT+K) = DIG(1:K)
4424            NTEXT = NTEXT + K
4425            TLENH = TLENH + dble(K)
4426            if (NDIG .gt. K) then
4427               NTEXT = NTEXT + 1
4428               TLENH = TLENH + .4D0 + dble(NDIG - K)
4429               TEXT(NTEXT:NTEXT) = '.'
4430C%%         memcpy(dplotc.text+dplotb.ntext, dig+k, (size_t)(ndig-k));
4431               TEXT(NTEXT+1:NTEXT+NDIG-K) = DIG(K+1:NDIG)
4432               NTEXT = NTEXT+NDIG-K
4433            else
4434               if (KTEN .ge. K) then
4435                  do 180 NTEXT = NTEXT, NTEXT + KTEN - K
4436                     TLENH = TLENH + 1.D0
4437                     TEXT(NTEXT+1:NTEXT+1) = '0'
4438  180             continue
4439               end if
4440               if (NEEDD) then
4441                  TLENH = TLENH + .4D0
4442                  NTEXT = NTEXT + 1
4443                  TEXT(NTEXT:NTEXT) = '.'
4444               end if
4445            end if
4446         end if
4447      end if
4448      if (DOL) then
4449         NTEXT = NTEXT + 1
4450         TEXT(NTEXT:NTEXT) = '$'
4451      end if
4452
4453c     Convert TLENH to physical distance
4454      PTSIZ = NPTSIZ
4455      TLENH = .5D0 * TLENH * PTSIZ
4456      TLENV = PTSIZ
4457      if ((KASE .le. 2) .or. (KASE .eq. 5)) then
4458         if (KASE .eq. LKASE) then
4459c                               Check for overlap
4460            if (mod(LKASE, 2) .eq. 1) then
4461               K = index('lLcCrR', ALIGN(2:2))
4462               if (K .ne. 0) then
4463                  K = (K + 1) / 2
4464                  if (OVLAP .gt. XYPOS(1) - TLENH * HADJ(K)) return
4465c                               Set the new overlap
4466                  OVLAP = XYPOS(1) + HADJ(4-K) * TLENH
4467               end if
4468            end if
4469         end if
4470      end if
4471      if (NOOUT) return
4472      call DPLOTT( KASE, XYPOS)
4473      LKASE = KASE
4474      return
4475      end
4476
4477      subroutine DPLOTT( KASE, XYPOS)
4478c Copyright (c) 1997, California Institute of Technology. U.S.
4479c Government Sponsorship under NASA Contract NAS7-1260 is acknowledged.
4480c
4481c For output ot text, and getting size of such output.
4482c
4483c ************************* Calling Sequence variables *****************
4484c
4485c KASE   1-4 for bottom, left, top,right borders, 5 and 6 for x and y
4486c   axis, 8 for words, 10-15 for captions, 16 for output text.
4487
4488c        Indices, 1-16, are for: Borders (bottom, left, top, right),
4489c   x-axis, y-axis, word alignment (e.g. for option 14), number
4490c   formatting for option 15, Captions (as for borders), alignment
4491c   rule for option 16.
4492
4493
4494c XYPOS  Gives (x,y), the position for the text in physical coordinates.
4495c TEXT   The Text to output.
4496c
4497c ************************* Usage of internal variables ****************
4498c
4499c ADJ1   Used for first point ajustment on box.
4500c ADJ2   Used for second point ajustment on box.
4501c ADJH   Used to get index for horizontal adjustment of boxes.
4502c ADJV   Used to get index for vertical adjustment of boxes.
4503c FMTSAV Saved value for the last format specification.
4504c GETSIZ Logical variable that is .true. if need to get size.
4505c HLEN   Largest horizontal space required if not stacked, and the final
4506c    value required in any case.
4507c HLENS  Largest horizontal space required for various vertical cases.
4508c    Also used as a temp.
4509c HLSAV  Horizontal space required at the start of a "{" or "$" group.
4510c LASTL  Length of text for the last format specification.
4511c LFILL2 Used to pass a length 3 array with a two in the first position,
4512c    to DPLOT7.
4513c OUTTXT Final output form (aside from prefix and postfix, which are
4514c    added in DPLOT
4515c PTSIZ  Gives the size in points for the text being output.
4516c VERT   Logical variable that is true if "stacking" the text.
4517c VLEN   Vertical space required so far.
4518c
4519c *************************** Variable Declarations ********************
4520c
4521c Common
4522c  For DPLOT0
4523      double precision ARRLEN, PXO, PXSIZE, PYO, PYSIZE
4524C++ CODE for ~.C. is active
4525      integer IOFIL, IPLOT, KURPEN, LASPEN
4526      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
4527     1   IOFIL, IPLOT, KURPEN, LASPEN
4528C++ CODE for .C. is inactive
4529C      integer IPLOT, KURPEN, LASPEN
4530C      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
4531C     1   IPLOT, KURPEN, LASPEN
4532C++ END
4533      save /DPLOTD/
4534c
4535c         Parameter pointers for integers in IP.
4536      integer NEXT, INTERP, LCOOX,LCOOY,LXLINE,LXBORD,LYBORD, LTYPE,
4537     1  KSET, LTANNO, LPEN, NBORD, LYDIM, LNY, LDEBUG,
4538     2  LASTIP
4539      parameter (NEXT=1, INTERP=2, LCOOX=3, LCOOY=4, LXLINE=5,
4540     1  LXBORD=6, LYBORD=7, LTYPE=8, KSET=9, LTANNO=10, LPEN=13,
4541     2  NBORD=14, LYDIM=15, LNY=16, LDEBUG=18, LASTIP=LDEBUG)
4542c          Parameter pointers for floats in FP.
4543      integer LARROW,LWIDTH,LWIDRE,LBAD,LVALS,LXYSIZ,LASTFP,LFDAT
4544      parameter (LARROW=1, LWIDTH=2, LWIDRE=6, LBAD=7,
4545     1  LVALS=9, LXYSIZ=LVALS+5, LASTFP=LXYSIZ+2,LFDAT=LBAD)
4546c          Parameter for various sizes.
4547      integer LBNDC, LBNDF, LBNDP, LBNDT, MAXSET
4548      parameter (LBNDC=128, LBNDF=32, LBNDP=4, LBNDT=64, MAXSET=20)
4549      double precision BORLOC(6), FILL(19), FP(LASTFP), OVLAP,
4550     1  PHYUSE(2,2), SETLIM(2,2), TLENH, TLENV, TICKS(4,6), TOPTS,
4551     2  VHLEN(2), XYBASE(MAXSET), XYLIM(2,MAXSET), XYU2PF(MAXSET)
4552      integer IERR1, IERR2, IERR3, IERR4, IOP1, IP(LASTIP), JSET(2),
4553     1  LENCAP(6), LENTXT(3,18), MANNO, MBORD(8,6), MFILL(4), NTEXT,
4554     2  NXYLIM(MAXSET)
4555      logical  KLIP(MAXSET), NOOUT, OPAQUE
4556      common / DPLOTB / BORLOC, FILL, FP, OVLAP, PHYUSE, SETLIM, TICKS,
4557     1  TLENH, TLENV, TOPTS, VHLEN, XYBASE, XYLIM, XYU2PF, IERR1,
4558     2  IERR2, IERR3, IERR4, IOP1, IP, JSET, LENCAP, LENTXT, MANNO,
4559     3  MBORD, NTEXT, NXYLIM, KLIP, MFILL, NOOUT, OPAQUE
4560c
4561      character FMTNUM(17)*(LBNDF), CAPTIO(6)*(LBNDC), POS*68, TEXT*280,
4562     1    TXTDEF(18)*(LBNDT)
4563      common / DPLOTC / FMTNUM, CAPTIO, POS, TEXT, TXTDEF
4564      save /DPLOTB/, /DPLOTC/
4565c Locals
4566      integer KASE
4567      double precision XYPOS(2)
4568c
4569      logical GETSIZ, VERT
4570      character ADJH*3, ADJV*3, C, FMTSAV*(LBNDF), OUTTXT*256
4571      integer I, IAX, J, K, L, LASTL, LFILL2(3), LPAR
4572      double precision ADJ1(3), ADJ2(3), HLEN, HLENS, HLSAV, PTSIZ, TP1,
4573     1  TP2, VLEN
4574      save LASTL, FMTSAV, PTSIZ
4575c
4576c Weird stuff to take care of "\" being treated as an escape character
4577c on SGI Fortran compilers
4578      character BSHORT*16
4579      character BSLAS2*2
4580      character BSMALL*7
4581C++ CODE for ~.C. is active
4582      character BSLAS1*(*), BSLASH
4583      parameter (BSLAS1 = '\\')
4584      parameter (BSLASH = BSLAS1(1:1))
4585c
4586      parameter (BSHORT=BSLASH//'shortstack[  ]{')
4587      parameter (BSLAS2=BSLAS1(1:1)//BSLAS1(1:1))
4588      parameter (BSMALL=BSLASH//'small ')
4589C++ CODE for .C. is inactive
4590C      character BSLASH
4591C      parameter (BSLASH='\\')
4592C      parameter (BSHORT='\shortstack[  ]{')
4593C      parameter (BSLAS2='\\')
4594C      parameter (BSMALL='\small ')
4595C++END
4596c
4597      data LASTL, LFILL2 / -2, 2, 0, 0 /
4598      data ADJV, ADJH / 'tcb', 'rcl' /
4599      data ADJ1 / -1.D0, -.5D0, 0.D0 /
4600      data ADJ2 / 0.D0, .5D0, 1.D0 /
4601c
4602c *************************** Start of Executable Code *****************
4603c
4604      IAX = 2 - mod(KASE, 2)
4605      VERT = (POS(4*KASE-1:4*KASE-1) .eq. 's')
4606      GETSIZ = NOOUT .or. OPAQUE .or. (MANNO .ne. 0)
4607      if (GETSIZ .or. VERT) then
4608         if (GETSIZ) then
4609            VERT = VERT .or. ((IAX .eq. 2) .and. (MANNO .eq. 0) .and.
4610     1         (POS(4*KASE-3:4*KASE-3) .eq. 'c'))
4611            L = LENTXT(1, KASE)
4612            if (L .eq. LASTL) then
4613c                     Format hasn't changed
4614C%%  if (memcmp(dplotc.fmtnum[kase-1],fmtsav,(size_t)l)==0) goto L_60;
4615               if (FMTNUM(KASE)(1:L) .eq. FMTSAV(1:L)) go to 60
4616            end if
4617            LASTL = L
4618            PTSIZ = 9.D0
4619            if (L .gt. 0) then
4620C%%            memcpy(fmtsav, dplotc.fmtnum[kase-1], (size_t)l);
4621               FMTSAV(1:L) = FMTNUM(KASE)(1:L)
4622               K = 0
4623   20          if (K .lt. L) then
4624                  if ((FMTNUM(KASE)(K:K) .eq. 'F') .or.
4625     1               (FMTNUM(KASE)(K:K).eq.'f')) then
4626c                      Get the following number
4627                     J = 0
4628   40                K = K + 1
4629                     if (K .le. LASTL) then
4630                        C = FMTSAV(K:K)
4631                        if ((C .ge. '0') .and. (C .le. '9')) then
4632                           J = 10*J + ichar(C) - ichar('0')
4633                           go to 40
4634                        end if
4635                     end if
4636                     if ((J.ge.5) .and. (J.le.30)) PTSIZ = J
4637                  end if
4638                  K = K + 1
4639                  go to 20
4640               end if
4641            end if
4642         end if
4643c        Accumlate sizes and text
4644   60    VLEN = 0.D0
4645         HLEN = 0.D0
4646         HLENS = 0.D0
4647         LPAR = 0
4648         I = 0
4649         J = LBNDT-1
4650         if (VERT) then
4651            J = LBNDT + 16
4652            OUTTXT(LBNDT:J) = BSHORT
4653         end if
4654C%%      memcpy(outtxt+j-5, dplotc.pos+kase*4-4, (size_t)2);
4655         OUTTXT(J-4:J-3) = POS(4*KASE-3:4*KASE-2)
4656   80    I = I + 1
4657         if (I .le. NTEXT) then
4658            C = TEXT(I:I)
4659            if (C .eq. BSLASH) then
4660               J = J + 1
4661               OUTTXT(J:J) = BSLASH
4662c                          Skip '\' commands.
4663   90          I = I + 1
4664               C = TEXT(I:I)
4665               if (((C .ge. 'a') .and. (C .le. 'z')) .or.
4666     1             ((C .ge. 'A') .and. (C .le. 'Z'))) then
4667                  J = J + 1
4668                  OUTTXT(J:J) = C
4669                  go to 90
4670               end if
4671            end if
4672            if (C .eq. '{') then
4673               LPAR = LPAR + 1
4674               if (LPAR .eq. 1) then
4675                  HLSAV = HLEN
4676               end if
4677               go to 100
4678            else if (C .eq. '}') then
4679               LPAR = LPAR - 1
4680               if (LPAR .eq. 0) HLENS = max(HLENS, HLEN - HLSAV)
4681               go to 100
4682c               if (LPAR .ne. 0) go to 100
4683c               HLENS = max(HLENS, HLEN - HLSAV)
4684c               go to 80
4685            else if (C .eq. '$') then
4686               if (LPAR .ge. 100) then
4687                  LPAR = LPAR - 100
4688               else
4689                  if (LPAR .eq. 0) HLSAV = HLEN
4690                  LPAR = LPAR + 100
4691               end if
4692               if (LPAR .eq. 0) HLENS = max(HLENS, HLEN - HLSAV)
4693               go to 100
4694            else if (C .eq. '^') then
4695               HLEN = HLEN - .3D0
4696               go to 100
4697            end if
4698            if (VERT .and. (LPAR .eq. 0)) then
4699               J = J + 2
4700               OUTTXT(J-1:J) = BSLAS2
4701               VLEN = VLEN + 1.D0
4702            end if
4703            HLEN = HLEN + 1.D0
4704  100       J = J + 1
4705            OUTTXT(J:J) = C
4706            go to 80
4707         end if
4708         if (LPAR .ne. 0) then
4709c                Error -- Caption doesn''t have balanced {...} or $...$.
4710            call DPLOTE(6, XYPOS, TEXT)
4711         end if
4712         if (NOOUT) then
4713            if ((IAX.eq.2) .and. (POS(4*KASE:4*KASE).eq.'.')) then
4714               if (HLENS .lt. HLEN - 2) POS(4*KASE-1:4*KASE) = 'sc'
4715            end if
4716            if (POS(4*KASE-1:4*KASE-1).eq.'s') then
4717               HLEN = HLENS
4718            else
4719               VLEN = 1
4720            end if
4721            VHLEN(1) = PTSIZ * VLEN
4722            VHLEN(2) = .5D0 * PTSIZ * HLEN
4723            return
4724         end if
4725         if (VERT) then
4726            J = J + 1
4727            OUTTXT(J:J) = '}'
4728         end if
4729         if (MANNO .ne. 0) then
4730c                          Some kind of annotation.
4731            K = index(ADJV, POS(4*KASE-3:4*KASE-3))
4732            L = index(ADJH, POS(4*KASE-2:4*KASE-2))
4733            HLENS = .5D0 * PTSIZ * HLEN
4734            TP1 = XYPOS(1)+ADJ1(L)*HLENS-.5D0
4735            TP2 = XYPOS(1)+ADJ2(L)*HLENS+.5D0
4736            if (MANNO .gt. 0) then
4737               if ((TP1 .lt. BORLOC(2)) .or. (TP2 .gt. BORLOC(4)))
4738     1            call DPLOTE(7, XYPOS, TEXT)
4739            else
4740               if ((TP1.ge.0.D0) .and. (TP1.lt.BORLOC(2) - MBORD(8,5)))
4741     1           MBORD(8,5) = BORLOC(2) - TP1
4742               if ((TP2.ge.0.D0) .and. (TP2.gt.BORLOC(4) + MBORD(8,6)))
4743     1           MBORD(8,6) = TP2 - BORLOC(4)
4744            end if
4745         end if
4746         if (OPAQUE) then
4747            I = 1
4748            call DPLOT7(I, LFILL2, FILL)
4749            call DPLOT5(XYPOS(1)+ADJ1(L)*HLENS-.5D0,
4750     1         XYPOS(2)+PTSIZ*ADJ1(K), XYPOS(1)+ADJ2(L)*HLENS+.5D0,
4751     3         XYPOS(2)+PTSIZ*ADJ2(K))
4752         end if
4753      else
4754c                 Just copy the text -- easy case.
4755         J = LBNDT
4756C%%      memcpy(outtxt+j-1, dplotc.text, (size_t)dplotb.ntext);
4757         OUTTXT(J:J+NTEXT-1) = TEXT(1:NTEXT)
4758         J = J + NTEXT-1
4759      end if
4760c                Take care of prefix and postfix.
4761      I = LBNDT
4762      L = LENTXT(2, KASE)
4763      K = LENTXT(3, KASE)
4764      if (K .lt. 0) then
4765         if ((IP(LTYPE) .eq. 0) .and. (K .eq. -1)) then
4766c                              The default prefix for LaTeX.
4767             OUTTXT(I-7:I-1) = BSMALL
4768             I = I - 7
4769         end if
4770      else
4771         if (L .gt. 0) then
4772c                              Prefix is specified.
4773C%%         memcpy(outtxt+i-l-1, dplotc.txtdef[kase-1], (size_t)l);
4774            OUTTXT(I-L:I) = TXTDEF(KASE)(1:L)
4775            I = I - L
4776         end if
4777         if (K .ne. 0) then
4778c                              Postfix is specified.
4779C%%         memcpy(outtxt+j, dplotc.txtdef[kase-1]+l+1,(size_t)(k-l-l));
4780            OUTTXT(J+1:J+K-L-1) = TXTDEF(KASE)(L+2:K)
4781            J = J + K - L - 1
4782         end if
4783      end if
4784c Output the text
4785C%%   *(outtxt+j) = '\0';
4786C%%   dplot4( Xypos[1], Xypos[2], outtxt+i-1, dplotc.pos+kase*4-4);
4787      call DPLOT4(XYPOS(1),XYPOS(2),OUTTXT(I:J),POS(4*KASE-3:4*KASE-2))
4788      return
4789      end
4790
4791      subroutine DPLOTR(XY, KSYMB, KX, KY)
4792c     Gets XY converted for call to DPLOTS (Symbols, error bars, arrows)
4793      double precision XY(*)
4794      integer KSYMB, KX, KY
4795c
4796      integer K
4797c Common
4798c  For DPLOT0
4799      double precision ARRLEN, PXO, PXSIZE, PYO, PYSIZE
4800C++ CODE for ~.C. is active
4801      integer IOFIL, IPLOT, KURPEN, LASPEN
4802      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
4803     1   IOFIL, IPLOT, KURPEN, LASPEN
4804C++ CODE for .C. is inactive
4805C      integer IPLOT, KURPEN, LASPEN
4806C      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
4807C     1   IPLOT, KURPEN, LASPEN
4808C++ END
4809      save /DPLOTD/
4810c
4811c         Parameter pointers for integers in IP.
4812      integer NEXT, INTERP, LCOOX,LCOOY,LXLINE,LXBORD,LYBORD, LTYPE,
4813     1  KSET, LTANNO, LPEN, NBORD, LYDIM, LNY, LDEBUG,
4814     2  LASTIP
4815      parameter (NEXT=1, INTERP=2, LCOOX=3, LCOOY=4, LXLINE=5,
4816     1  LXBORD=6, LYBORD=7, LTYPE=8, KSET=9, LTANNO=10, LPEN=13,
4817     2  NBORD=14, LYDIM=15, LNY=16, LDEBUG=18, LASTIP=LDEBUG)
4818c          Parameter pointers for floats in FP.
4819      integer LARROW,LWIDTH,LWIDRE,LBAD,LVALS,LXYSIZ,LASTFP,LFDAT
4820      parameter (LARROW=1, LWIDTH=2, LWIDRE=6, LBAD=7,
4821     1  LVALS=9, LXYSIZ=LVALS+5, LASTFP=LXYSIZ+2,LFDAT=LBAD)
4822c          Parameter for various sizes.
4823      integer LBNDC, LBNDF, LBNDP, LBNDT, MAXSET
4824      parameter (LBNDC=128, LBNDF=32, LBNDP=4, LBNDT=64, MAXSET=20)
4825      double precision BORLOC(6), FILL(19), FP(LASTFP), OVLAP,
4826     1  PHYUSE(2,2), SETLIM(2,2), TLENH, TLENV, TICKS(4,6), TOPTS,
4827     2  VHLEN(2), XYBASE(MAXSET), XYLIM(2,MAXSET), XYU2PF(MAXSET)
4828      integer IERR1, IERR2, IERR3, IERR4, IOP1, IP(LASTIP), JSET(2),
4829     1  LENCAP(6), LENTXT(3,18), MANNO, MBORD(8,6), MFILL(4), NTEXT,
4830     2  NXYLIM(MAXSET)
4831      logical  KLIP(MAXSET), NOOUT, OPAQUE
4832      common / DPLOTB / BORLOC, FILL, FP, OVLAP, PHYUSE, SETLIM, TICKS,
4833     1  TLENH, TLENV, TOPTS, VHLEN, XYBASE, XYLIM, XYU2PF, IERR1,
4834     2  IERR2, IERR3, IERR4, IOP1, IP, JSET, LENCAP, LENTXT, MANNO,
4835     3  MBORD, NTEXT, NXYLIM, KLIP, MFILL, NOOUT, OPAQUE
4836c
4837      character FMTNUM(17)*(LBNDF), CAPTIO(6)*(LBNDC), POS*68, TEXT*280,
4838     1    TXTDEF(18)*(LBNDT)
4839      common / DPLOTC / FMTNUM, CAPTIO, POS, TEXT, TXTDEF
4840      save /DPLOTB/, /DPLOTC/
4841c
4842      K = mod(abs(KSYMB), 10)
4843      if (K .eq. 1) then
4844         K = mod(abs(KSYMB)/10, 10)
4845         if (K .le. 1) then
4846            XY(6) = XY(2) + XY(3)
4847            if (K .eq. 1) XY(2) = XY(2) + XY(4)
4848            XY(4) = XY(2) - XY(3)
4849            XY(5) = XY(1)
4850            XY(3) = XY(1)
4851            K = 3
4852         else
4853            XY(4) = XY(2) + XY(4)
4854            XY(3) = XY(1) + XY(3)
4855         end if
4856      else
4857         K = 1
4858      end if
4859      do 100 K = 1, 2*K, 2
4860         if (KSYMB .ge. 0) then
4861c                   Convert to physical and plot
4862            XY(K) = XYBASE(KX) + XYU2PF(KX) * XY(K)
4863            XY(K+1) = XYBASE(KY) + XYU2PF(KY) * XY(K+1)
4864         else
4865c       Convert to points.
4866           XY(K) = TOPTS * XY(K)
4867           XY(K+1) = TOPTS * XY(K+1)
4868         end if
4869  100 continue
4870      call DPLOTS(XY, abs(KSYMB))
4871      return
4872      end
4873
4874C++ CODE for ~.C. is active
4875      subroutine DPLOTU (NEWU, FILNAM)
4876c Get an unused unit number, open it for unformatted sequential scratch
4877c usage if FILNAM is ' ', else open for formatted sequential output.
4878      integer NEWU
4879      character FILNAM*(*)
4880      double precision SPACE(1)
4881      logical OPENED
4882      integer IORES, NEXTU
4883      save NEXTU
4884c Common  Variables
4885c
4886c         Parameter pointers for integers in IP.
4887      integer NEXT, INTERP, LCOOX,LCOOY,LXLINE,LXBORD,LYBORD, LTYPE,
4888     1  KSET, LTANNO, LPEN, NBORD, LYDIM, LNY, LDEBUG,
4889     2  LASTIP
4890      parameter (NEXT=1, INTERP=2, LCOOX=3, LCOOY=4, LXLINE=5,
4891     1  LXBORD=6, LYBORD=7, LTYPE=8, KSET=9, LTANNO=10, LPEN=13,
4892     2  NBORD=14, LYDIM=15, LNY=16, LDEBUG=18, LASTIP=LDEBUG)
4893c          Parameter pointers for floats in FP.
4894      integer LARROW,LWIDTH,LWIDRE,LBAD,LVALS,LXYSIZ,LASTFP,LFDAT
4895      parameter (LARROW=1, LWIDTH=2, LWIDRE=6, LBAD=7,
4896     1  LVALS=9, LXYSIZ=LVALS+5, LASTFP=LXYSIZ+2,LFDAT=LBAD)
4897c          Parameter for various sizes.
4898      integer LBNDC, LBNDF, LBNDP, LBNDT, MAXSET
4899      parameter (LBNDC=128, LBNDF=32, LBNDP=4, LBNDT=64, MAXSET=20)
4900      double precision BORLOC(6), FILL(19), FP(LASTFP), OVLAP,
4901     1  PHYUSE(2,2), SETLIM(2,2), TLENH, TLENV, TICKS(4,6), TOPTS,
4902     2  VHLEN(2), XYBASE(MAXSET), XYLIM(2,MAXSET), XYU2PF(MAXSET)
4903      integer IERR1, IERR2, IERR3, IERR4, IOP1, IP(LASTIP), JSET(2),
4904     1  LENCAP(6), LENTXT(3,18), MANNO, MBORD(8,6), MFILL(4), NTEXT,
4905     2  NXYLIM(MAXSET)
4906      logical  KLIP(MAXSET), NOOUT, OPAQUE
4907      common / DPLOTB / BORLOC, FILL, FP, OVLAP, PHYUSE, SETLIM, TICKS,
4908     1  TLENH, TLENV, TOPTS, VHLEN, XYBASE, XYLIM, XYU2PF, IERR1,
4909     2  IERR2, IERR3, IERR4, IOP1, IP, JSET, LENCAP, LENTXT, MANNO,
4910     3  MBORD, NTEXT, NXYLIM, KLIP, MFILL, NOOUT, OPAQUE
4911c
4912      data NEXTU / 10 /
4913
4914c
4915      do 100 NEWU = NEXTU, 100
4916          inquire (unit=NEWU, opened=OPENED)
4917          if (.not. OPENED) then
4918            if (FILNAM(1:1) .eq. ' ') then
4919               open (unit=NEWU, status='SCRATCH', access='SEQUENTIAL'
4920     1,           form='UNFORMATTED', iostat=IORES)
4921               if (IORES .eq. 0) go to 300
4922               close (unit=NEWU)
4923            else
4924              open (unit=NEWU, FILE=FILNAM, status='UNKNOWN'
4925     1,       form='FORMATTED', access='SEQUENTIAL', iostat=IORES
4926     2,       err=200)
4927              go to 300
4928            end if
4929          end if
4930  100 continue
4931c          Unable to find unused I/O unit number in 10..100
4932      call DPLOTE(34, SPACE, ' ')
4933      return
4934c                  Unable to open output file
4935  200 IERR1 = len(FILNAM)
4936      call DPLOTE(35, SPACE, FILNAM)
4937      return
4938c                 "Success" exit
4939  300 NEXTU = NEWU + 1
4940      return
4941C++ END
4942C%%
4943      end
4944
4945      subroutine DPLOT0
4946c Copyright (c) 1996, California Institute of Technology. U.S.
4947c Government Sponsorship under NASA Contract NAS7-1260 is acknowledged.
4948c>> 1997-01-09 DPLOT0   Krogh Initial code.
4949C++ Current has HOW=MFPIC
4950c
4951c Much modified from earlier code by Van Snyder.
4952c Most dependencies of the plot package on mfpic are captured in this
4953c file.  This code was originally in a separate file.  Files combined
4954c because of problems in C with iofil being external.
4955c
4956c Start the plot.
4957c
4958c ***************************** Common Block ***************************
4959c
4960c ARRLEN If nonzero, next line or curve is to have an arrow on the end.
4961c    This give the length of the arrow in points.
4962c PXO, PYO     Origin of logical coordinate system in physical units.
4963c PXSIZE, PYSIZE Physical X and Y width of the plot, including outward-
4964c              pointing tick marks.
4965c IOFIL Unit number used for output to be used for plot device.
4966c    Temporarily increased by 1000 when want to end one mfpic group and
4967c    immediately start another.
4968c IPLOT Defines output, 0 for LaTeX, 1 for TeX.
4969c KURPEN Rule defining the current pen.  Defined as for P3 of option 3.
4970c   KURPEN = t + 10*(w + 100*(L1 + 100*L2)), where t is 0, 1, or 2 for
4971c   solid, dotted, or dashed lines.  t = 3 or 4 is as for 1 or 2, except
4972c   L1 is given in deci-points instead of points, and t = 5-8, is as for
4973c   1-4, except L2 if in deci-points instead of in points.  w is the
4974c   width of the line in decipoints, L1 and L2 are not used for solid
4975c   lines.  Else L1 is the diameter of the dots or the lenght of the
4976c   dashes, and L2 is the distance between the dots or dashes.
4977c LASPEN The last value assigned to KURPEN.
4978c
4979c *************************** Internal Variables ***********************
4980c
4981c ISTART  Points to place where text in START starts for a give value
4982c   in IPLOT.  (Only 0 and 1 supported.)
4983c START   TeX command to write at the beginning -- \begin{mfpic} or
4984c         \mfpic.
4985c
4986c **************************** Variable Declarations *******************
4987c
4988c Common
4989c  For DPLOT0
4990      double precision ARRLEN, PXO, PXSIZE, PYO, PYSIZE
4991C++ CODE for ~.C. is active
4992      integer IOFIL, IPLOT, KURPEN, LASPEN
4993      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
4994     1   IOFIL, IPLOT, KURPEN, LASPEN
4995C++ CODE for .C. is inactive
4996C      integer IPLOT, KURPEN, LASPEN
4997C      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
4998C     1   IPLOT, KURPEN, LASPEN
4999C++ END
5000      save /DPLOTD/
5001c Locals
5002      integer ISTART(0:2)
5003c
5004c Weird stuff to take care of "\" being treated as an escape character
5005c on SGI Fortran compilers
5006      character START*19
5007C++ CODE for ~.C. is active
5008      character BSLAS1*(*), BSLASH
5009      parameter (BSLAS1 = '\\')
5010      parameter (BSLASH = BSLAS1(1:1))
5011      character PSTART*19
5012      parameter (PSTART=BSLASH//'begin{mfpic}'//BSLASH//'mfpic')
5013      data START / PSTART /
5014C++ CODE for .C. is inactive
5015CC                   12345678901234567890
5016C      data START / '\begin{mfpic}\mfpic' /
5017C++END
5018c Data
5019      data ISTART / 1, 14, 20 /
5020c
5021C%%   const char fmt10[] = " %.*s[ 1.0 ]{%9.3f}{%9.3f}{%9.3f}{%9.3f}\n";
5022   10 format (1x, a ,'[ 1.0 ]',4('{',f9.3,'}'))
5023c
5024c *********     Executable Statements     ******************************
5025C++ CODE for ~.C. is active
5026      write (IOFIL, 10) START(ISTART(IPLOT):ISTART(IPLOT+1)-1),
5027     1   -PXO, PXSIZE, -PYO, PYSIZE
5028C++ CODE for .C. is inactive
5029c%%   fprintf(iofil, fmt10, (int)(istart[dplotd.iplot+1]-
5030c%%     istart[dplotd.iplot]), start+istart[dplotd.iplot]-1,
5031c%%     -dplotd.pxo, dplotd.pxsize, -dplotd.pyo, dplotd.pysize );
5032C++ END
5033      LASPEN = 50
5034      return
5035      end
5036
5037c==================================================     DPLOT1     =====
5038      subroutine DPLOT1
5039c Specify the pen characteristics
5040c
5041c **** Variable Definitions (<name*> means variable is in common) ******
5042c
5043c ARRLEN* Length of arrow head to be drawn on next curve.
5044c DASH    Length of dashes
5045c DASHSP  Length of space between dashes.
5046c DOTSP   Length of space between dots.
5047c DOTSZ   Size of the dots.
5048c IOFIL*  Output unit.
5049c IT      Type of Line.  Low digit of KURPEN.
5050c      0     Solid line
5051c      1     Dashed line
5052c      2     Dotted line
5053c     3:4    As for 1:2, except units for the length of the dashes or
5054c            dots are given in deci-points instead of in points.
5055c     5:8    As for 1:4, except units for the length of the spaces are
5056c            in deci-points instead of in points
5057c KURPEN* A packed integer, giving information on the kind of curve or
5058c         line to draw, = IT + 10*(PENWID+10*(length or size + 10*(space
5059c         between dots or dashes))).
5060c L       Temp., used for the integer resulting from unpacking KURPEN.
5061c LASPEN  The previous value of KURPEN.
5062c PENWID  The width of the last line drawn.
5063c TP1     For temporary storage and to distinguish point/deci-points.
5064c TP2     For temporary storage and to distinguish point/deci-points.
5065c
5066c **************************** Variable Declarations *******************
5067c
5068c Common
5069c  For DPLOT0
5070      double precision ARRLEN, PXO, PXSIZE, PYO, PYSIZE
5071C++ CODE for ~.C. is active
5072      integer IOFIL, IPLOT, KURPEN, LASPEN
5073      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5074     1   IOFIL, IPLOT, KURPEN, LASPEN
5075C++ CODE for .C. is inactive
5076C      integer IPLOT, KURPEN, LASPEN
5077C      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5078C     1   IPLOT, KURPEN, LASPEN
5079C++ END
5080      save /DPLOTD/
5081c Locals
5082      integer IT, L
5083      double precision DASH, DASHSP, DOTSZ, DOTSP, PENWID, TP1, TP2
5084      save DASH, DASHSP, DOTSZ, DOTSP, PENWID, IT
5085      data DASH, DASHSP, DOTSZ, DOTSP, PENWID /4*-1.D0, .5D0/
5086c
5087C++ CODE for ~.C. is active
5088c Weird stuff to take care of "\" being treated as an escape character
5089c on SGI Fortran compilers
5090      character BSLAS1*(*), BSLASH
5091      parameter (BSLAS1 = '\\')
5092      parameter (BSLASH = BSLAS1(1:1))
5093      character*(*) BFMT1, BFMT2, BFMT3, BFMT4, BFMT5, BFMT6
5094      parameter (BFMT1='('''//BSLASH//'arrow[l '',f6.3,''pt]'')',
5095     1  BFMT2='('''//BSLASH//'pen{'',F6.3,''pt}'')',
5096     2  BFMT3='( '''//BSLASH//'dashlen='',F6.3,''pt'')',
5097     3  BFMT4='( '''//BSLASH//'dashspace='',F6.3,''pt'')',
5098     4  BFMT5='( '''//BSLASH//'dotsize='',F6.3,''pt'')',
5099     5  BFMT6='( '''//BSLASH//'dotspace='',F6.3,''pt'')')
5100      character*(*) BDASH, BDOT
5101      parameter (BDASH='('''//BSLASH//'dashed'')',
5102     1  BDOT='('''//BSLASH//'dashed'')')
5103
5104C++ CODE for .C. is inactive
5105C%%   const char fmt10[] = "\\arrow[l %6.3fpt]\n";
5106C%%   const char fmt20[] = "\\pen{%6.3fpt}\n";
5107C%%   const char fmt30[] = " \\dashlen{%6.3fpt}\n";
5108C%%   const char fmt40[] = " \\dashspace{%6.3fpt}\n";
5109C%%   const char fmt50[] = " \\dotsize{%6.3fpt}\n";
5110C%%   const char fmt60[] = " \\dotspace{%6.3fpt}\n";
5111C++ END
5112c
5113c *********     Executable Statements     ******************************
5114c
5115      if (KURPEN .eq. LASPEN) go to 100
5116      LASPEN = KURPEN
5117      L = LASPEN
5118      IT = mod(L, 10)
5119      L = L / 10
5120      TP1 = dble(mod(L, 100)) / 10.D0
5121      if (TP1 .eq. 0.D0) TP1 = .5D0
5122C%%   if (tp1 != penwid) fprintf(iofil, fmt20, tp1);
5123      if (TP1 .ne. PENWID) write(IOFIL, BFMT2) TP1
5124      PENWID = TP1
5125      if (TP1 .eq. 0.D0) return
5126      L = L / 100
5127      TP1 = dble(mod(L, 100))
5128      TP2 = dble(L / 100)
5129      if (IT .gt. 0) then
5130         if (IT .gt. 4) then
5131            IT = IT - 4
5132            TP2 = TP2 / 10.D0
5133         end if
5134         if (IT .gt. 2) then
5135            IT = IT - 2
5136            TP1 = TP1 / 10.D0
5137         end if
5138         if (IT .eq. 1) then
5139            if (TP1 .eq. 0.D0) TP1 = 4.D0
5140            if (TP2 .eq. 0.D0) TP2 = .5D0 * TP1
5141C%%         if (tp1 != dash) fprintf(iofil, fmt30, tp1);
5142            if (TP1 .ne. DASH) write(IOFIL, BFMT3) TP1
5143            DASH = TP1
5144C%%         if (tp2 != dashsp) fprintf(iofil, fmt40, tp2);
5145            if (TP2 .ne. DASHSP) write(IOFIL, BFMT4) TP2
5146            DASHSP = TP2
5147         else
5148            if (TP1 .eq. 0.D0) TP1 = 1.5
5149            if (TP2 .eq. 0.D0) TP2 = .75D0 * TP1
5150            TP2 = TP2 + TP1
5151C%%         if (tp1 != dotsz) fprintf(iofil, fmt50, tp1);
5152            if (TP1 .ne. DOTSZ) write(IOFIL, BFMT5) TP1
5153            DOTSZ = TP1
5154C%%         if (tp2 != dotsp) fprintf(iofil, fmt60, tp2);
5155            if (TP2 .ne. DOTSP) write(IOFIL, BFMT6) TP2
5156            DOTSP = TP2
5157         end if
5158      end if
5159  100 if (ARRLEN .ne. 0) then
5160c                          Want an arrow on the next curve.
5161C%%      fprintf(iofil, fmt10, dplotd.arrlen);
5162         write (IOFIL, BFMT1) ARRLEN
5163         ARRLEN = 0
5164      end if
5165      if (IT .eq. 0) return
5166      if (IT .eq. 1) then
5167C%%      fprintf(iofil, "\\dashed\n");
5168         write(IOFIL, BDASH)
5169      else
5170C%%      fprintf(iofil, "\\dotted\n");
5171         write(IOFIL, BDOT)
5172      end if
5173      return
5174      end
5175
5176c==================================================     DPLOT2     =====
5177      subroutine DPLOT2 (X1, Y1, X2, Y2)
5178
5179c Draw a single straight line from (X1,Y1) to (X2,Y2) in physical
5180c coordinates.
5181
5182c IOFIL*  (In common) Gives Fortran I/O unit number for output file
5183c
5184      double precision X1, Y1, X2, Y2
5185c
5186c Common
5187c  For DPLOT0
5188      double precision ARRLEN, PXO, PXSIZE, PYO, PYSIZE
5189C++ CODE for ~.C. is active
5190      integer IOFIL, IPLOT, KURPEN, LASPEN
5191      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5192     1   IOFIL, IPLOT, KURPEN, LASPEN
5193C++ CODE for .C. is inactive
5194C      integer IPLOT, KURPEN, LASPEN
5195C      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5196C     1   IPLOT, KURPEN, LASPEN
5197C++ END
5198      save /DPLOTD/
5199c
5200C++ CODE for ~.C. is active
5201c Weird stuff to take care of "\" being treated as an escape character
5202c on SGI Fortran compilers
5203      character BSLAS1*(*), BSLASH
5204      parameter (BSLAS1 = '\\')
5205      parameter (BSLASH = BSLAS1(1:1))
5206      character*(*) BFMT1
5207      parameter (BFMT1='('' '//BSLASH//
5208     1  'lines{('',F9.3,'','',F9.3,''),('',F9.3,'','',F9.3,'')}'')')
5209C++ CODE for .C. is inactive
5210C%%   const char fmt10[] = " \\lines{(%9.3f,%9.3f),(%9.3f,%9.3f)}\n";
5211C++ END
5212c
5213c *********     Executable Statements     ******************************
5214c
5215      call DPLOT1
5216C%%   fprintf(iofil, fmt10,x1, y1, x2, y2);
5217      write (IOFIL, BFMT1)  X1, Y1, X2, Y2
5218      return
5219      end
5220
5221c==================================================     DPLOT4     =====
5222      subroutine DPLOT4 (X, Y, OTEXT, ALIGN)
5223
5224c Output an annotation at (X,Y) in physical coordinates.
5225
5226c X, Y    Physical coordinates of the annotation.
5227c OTEXT   The annotation
5228c ALIGN   Characters to control alignment.  The first is for vertical
5229c         alignment, and may be t (top), c (center) or b (bottom).  The
5230c         second is for horizontal alignment, and may be l (left),
5231c         r (right) or c (center).  Otherwise, ALIGN is blank.
5232
5233      double precision X, Y
5234      character ALIGN*2, OTEXT*(*)
5235c
5236c Common
5237c  For DPLOT0
5238      double precision ARRLEN, PXO, PXSIZE, PYO, PYSIZE
5239C++ CODE for ~.C. is active
5240      integer IOFIL, IPLOT, KURPEN, LASPEN
5241      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5242     1   IOFIL, IPLOT, KURPEN, LASPEN
5243C++ CODE for .C. is inactive
5244C      integer IPLOT, KURPEN, LASPEN
5245C      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5246C     1   IPLOT, KURPEN, LASPEN
5247C++ END
5248      save /DPLOTD/
5249c
5250C++ CODE for ~.C. is active
5251c Weird stuff to take care of "\" being treated as an escape character
5252c on SGI Fortran compilers
5253      character BSLAS1*(*), BSLASH
5254      parameter (BSLAS1 = '\\')
5255      parameter (BSLASH = BSLAS1(1:1))
5256      character*(*) BFMT1, BFMT2
5257      parameter (BFMT1='('' '//BSLASH//
5258     1  'tlabel['',A2, '']('', F9.3, '','', F9.3, ''){'', A, ''}'')',
5259     2  BFMT2='('' '//BSLASH//
5260     3  'tlabel('', f9.3, '','', f9.3, ''){'', A,''}'')')
5261C++ CODE for .C. is inactive
5262C%%   const char fmt10[] = " \\tlabel[%2.2s](%9.3f,%9.3f){%s}\n";
5263C%%   const char fmt20[] = " \\tlabel(%9.3f,%9.3f){%s}\n";
5264C++ END
5265c
5266c *********     Executable Statements     ******************************
5267c
5268C++ CODE for ~.C. is active
5269      if (ALIGN .ne. '  ') then
5270        write (IOFIL, BFMT1) ALIGN, X, Y, OTEXT
5271      else
5272        write (IOFIL, BFMT2) X, Y, OTEXT
5273      end if
5274C++ CODE for .C. is inactive
5275C%%   if (*align != ' ' || *(align+1) != ' ')
5276C%%     fprintf(iofil, fmt10, align, x, y, otext);
5277C%%   else
5278C%%     fprintf(iofil, fmt20, x, y, otext);
5279C++ END
5280      return
5281      end
5282
5283c==================================================     DPLOT5     =====
5284      subroutine DPLOT5 (X1, Y1, X2, Y2)
5285
5286c Draw a rectangle with corners at (X1,Y1) and (X2,Y2) in physical
5287c coordinates, with the fill type, and PENWID given.
5288
5289c (X1,Y1), (X2,Y2)  Physical coordinates of corners of rectangle.
5290
5291      double precision X1, Y1, X2, Y2
5292c
5293c Common
5294c  For DPLOT0
5295      double precision ARRLEN, PXO, PXSIZE, PYO, PYSIZE
5296C++ CODE for ~.C. is active
5297      integer IOFIL, IPLOT, KURPEN, LASPEN
5298      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5299     1   IOFIL, IPLOT, KURPEN, LASPEN
5300C++ CODE for .C. is inactive
5301C      integer IPLOT, KURPEN, LASPEN
5302C      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5303C     1   IPLOT, KURPEN, LASPEN
5304C++ END
5305      save /DPLOTD/
5306c
5307C++ CODE for ~.C. is active
5308c Weird stuff to take care of "\" being treated as an escape character
5309c on SGI Fortran compilers
5310      character BSLAS1*(*), BSLASH
5311      parameter (BSLAS1 = '\\')
5312      parameter (BSLASH = BSLAS1(1:1))
5313      character*(*) BFMT1
5314      parameter (BFMT1='('' '//BSLASH//
5315     1  'rect{('',F9.3,'','',F9.3,''),('',F9.3,'','',F9.3,'')}'')')
5316C++ CODE for .C. is inactive
5317C%%   const char fmt10[] = " \\rect{(%9.3f,%9.3f),(%9.3f,%9.3f)}\n";
5318C++ END
5319
5320c *********     Executable Statements     ******************************
5321
5322      call DPLOT1
5323C%%   fprintf(iofil, fmt10, x1, y1, x2, y2);
5324      write (IOFIL,BFMT1) x1, y1, x2, y2
5325      return
5326      end
5327
5328c==================================================     DPLOT6     =====
5329      subroutine DPLOT6 (X, Y, A, B, ANGLE)
5330
5331c Draw an ellipse with center at (X,Y) with axes A and B in physical
5332c coordinates, with axis A rotated ANGLE degrees counterclockwise from
5333c the positive X-axis direction.
5334
5335c (X,Y)   Physical coordinates of the center of the ellipse
5336c A, B    Axis lengths of the ellipse
5337c ANGLE   A axis is rotated ANGLE degrees counterclockwise from
5338c         the positive X-axis direction
5339
5340      double precision X, Y, A, B, ANGLE
5341
5342c Common
5343c  For DPLOT0
5344      double precision ARRLEN, PXO, PXSIZE, PYO, PYSIZE
5345C++ CODE for ~.C. is active
5346      integer IOFIL, IPLOT, KURPEN, LASPEN
5347      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5348     1   IOFIL, IPLOT, KURPEN, LASPEN
5349C++ CODE for .C. is inactive
5350C      integer IPLOT, KURPEN, LASPEN
5351C      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5352C     1   IPLOT, KURPEN, LASPEN
5353C++ END
5354      save /DPLOTD/
5355c
5356C++ CODE for ~.C. is active
5357c Weird stuff to take care of "\" being treated as an escape character
5358c on SGI Fortran compilers
5359      character BSLAS1*(*), BSLASH
5360      parameter (BSLAS1 = '\\')
5361      parameter (BSLASH = BSLAS1(1:1))
5362      character*(*) BFMT1, BFMT2
5363      parameter (BFMT1='('' '//BSLASH//
5364     1'ellipse['',f9.3,'']{('',f9.3,'','',f9.3,''),'',f9.3,'','',f9.3,
5365     2''}'')',
5366     3  BFMT2='('' '//BSLASH//
5367     4  'ellipse{('',f9.3,'','',f9.3,''),'',f9.3,'','',f9.3,''}'')')
5368C++ CODE for .C. is inactive
5369C%% const char fmt10[]=" \\ellipse[%9.3f]{(%9.3f,%9.3f),%9.3f,%9.3f}\n";
5370C%% const char fmt20[]=" \\ellipse{(%9.3f,%9.3f),%9.3f,%9.3f}\n";
5371C++ END
5372c
5373c *********     Executable Statements     ******************************
5374c
5375      call DPLOT1
5376      if (ANGLE .ne. 0) then
5377C%%      fprintf(iofil, fmt10, angle, x, y, a, b);
5378         write (IOFIL,BFMT1) ANGLE, X, Y, A, B
5379      else
5380C%%      fprintf(iofil, fmt20, x, y, a, b);
5381         write (IOFIL,BFMT2) X, Y, A, B
5382      end if
5383      return
5384      end
5385
5386c =================================================     DPLOT7     =====
5387      subroutine DPLOT7(M, LOCFIL, FILDEF)
5388c                       Takes care of fill requests
5389c
5390c HATCHW  Size of lines used for hatch lines.
5391c FILDEF  Vector giving giving dot size/space, and hatch info.  First 6
5392c   locs. are for 3 pairs of info for dots,  next 9 for 3 sets of thatch
5393c   info.
5394c J       Temp. to track index for fill pattern.
5395c JFILL   Data telling where to find things in SFILL.
5396c K       Temp. used to hold a value from LFILL.
5397c LOCFIL*  Array with fill pattern info.  Entries 1 to m of LOCFIL
5398c   contain actions indices as follows.
5399c       0   For no action, should not be used?
5400c       1   For fill with black.
5401c       2   For erase what preceded.
5402c       3   For shading with dots.
5403c       4   For shading with hatch lines.
5404c M       Absolute value gives the number of fill patterns.  M is set to
5405c   min (M, 0) on exit which has the effect of turning off filling after
5406c   a call when M > 0.
5407c SFILL  Text for output when LFILL( ,1:2) is 1 or 2.
5408c SHADEW Size of dots for shading.
5409c
5410c **************************** Variable Declarations *******************
5411c
5412c Common
5413c  For DPLOT0
5414      double precision ARRLEN, PXO, PXSIZE, PYO, PYSIZE
5415C++ CODE for ~.C. is active
5416      integer IOFIL, IPLOT, KURPEN, LASPEN
5417      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5418     1   IOFIL, IPLOT, KURPEN, LASPEN
5419C++ CODE for .C. is inactive
5420C      integer IPLOT, KURPEN, LASPEN
5421C      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5422C     1   IPLOT, KURPEN, LASPEN
5423C++ END
5424      save /DPLOTD/
5425c Locals
5426      integer M, LOCFIL(3)
5427      double precision FILDEF(19)
5428      integer J, JFILL(3), K
5429      double precision SHADEW, HATCHW
5430c
5431      character SFILL*13
5432C++ CODE for ~.C. is active
5433c Weird stuff to take care of "\" being treated as an escape character
5434c on SGI Fortran compilers
5435      character BSLAS1*(*), BSLASH
5436      parameter (BSLAS1 = '\\')
5437      parameter (BSLASH = BSLAS1(1:1))
5438      character*(*) BFMT1, BFMT2, BFMT3, BFMT4
5439      parameter (BFMT1='('' '//BSLASH//
5440     1  'thatch['', F9.3, '','', F9.3,'']'')',
5441     2  BFMT2='('' '//BSLASH//
5442     3  'shadewd{'', F9.3, ''}'')',
5443     4  BFMT3='('' '//BSLASH//
5444     5  'shade['', F9.3, '']'')',
5445     6  BFMT4='('' '//BSLASH//
5446     7  'hatchwd{'', F9.3, ''}'')')
5447      character PSFILL*13
5448      parameter (PSFILL=BSLASH//'gfill'//BSLASH//'gclear')
5449      data SFILL / PSFILL /
5450C++ CODE for .C. is inactive
5451CC                   12345678901234
5452C      data SFILL / '\gfill\gclear' /
5453C%%    const char fmt10[]=" \\thatch[%9.3f,%9.3f]\n";
5454C++ END
5455      data JFILL / 1, 7, 14 /
5456      data SHADEW, HATCHW / -1.D0, -1.D0 /
5457c
5458c *********     Executable Statements     ******************************
5459c
5460      do 200 J = 1, abs(M)
5461         K = LOCFIL(J)
5462         if (K .le. 2) then
5463
5464C%%     fprintf(iofil, " %.*s\n",(int)(jfill[k]-jfill[k-1]),
5465C%%         sfill+jfill[k-1]-1);
5466            write (IOFIL, '(1X, A)') SFILL(JFILL(K):JFILL(K+1)-1)
5467         else if (K .eq. 3) then
5468            if (FILDEF(2*J-1) .ne. SHADEW) then
5469               SHADEW = FILDEF(2*J - 1)
5470C%%            fprintf(iofil, " \\shadewd{%9.3f}\n", shadew);
5471               write (IOFIL, BFMT2) SHADEW
5472            end if
5473C%%         fprintf(iofil, " \\shade[%9.3f]\n", fildef[2*j-1]);
5474            write (IOFIL, BFMT3) FILDEF(2*J)
5475         else if (K .eq. 4) then
5476            if (FILDEF(3*J+4) .ne. HATCHW) then
5477               HATCHW = FILDEF(3*J+4)
5478C%%            fprintf(iofil, " \\hatchwd{%9.3f}\n", hatchw);
5479               write (IOFIL, BFMT4) HATCHW
5480            end if
5481C%%         fprintf(iofil, fmt10, fildef[3*j + 4], fildef[3*j + 5]);
5482            write (IOFIL, BFMT1) FILDEF(3*J+5), FILDEF(3*J+6)
5483         end if
5484  200 continue
5485      M = min(M, 0)
5486      return
5487      end
5488
5489c ==========================     DPLOT8     ============================
5490      subroutine DPLOT8(PENWID,BASE,STEP,TILL,TBEG,TEND,IAX, STRLOG)
5491c  Outputs tick marks for MFPIC (actually for METAFONT)
5492c  F. T. Krogh -- JPL -- August 6, 1997
5493c    PENWID The pen width
5494c    BASE   The starting point for the thing that varies.
5495c    STEP   The increment for the above.
5496c    TILL   The final point for the above.
5497c    TBEG   The location where the ticks start (constant for all ticks)
5498c    TEND   Where the ticks end (like TBEG).
5499c    IAX    = 1 for horizontal case, = 2 for vertical.
5500c    STRLOG < 0 for usual case.  Else give minimum location for logs.
5501c    IOFIL* The output unit
5502c## Maybe use IAX > 2 for polar cases??
5503c
5504c **************************** Variable Declarations *******************
5505c
5506      integer IAX
5507      double precision PENWID, BASE, STEP, TILL, TBEG, TEND, STRLOG
5508c
5509c Common
5510c  For DPLOT0
5511      double precision ARRLEN, PXO, PXSIZE, PYO, PYSIZE
5512C++ CODE for ~.C. is active
5513      integer IOFIL, IPLOT, KURPEN, LASPEN
5514      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5515     1   IOFIL, IPLOT, KURPEN, LASPEN
5516C++ CODE for .C. is inactive
5517C      integer IPLOT, KURPEN, LASPEN
5518C      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5519C     1   IPLOT, KURPEN, LASPEN
5520C++ END
5521      save /DPLOTD/
5522c
5523C++ CODE for ~.C. is active
5524c Weird stuff to take care of "\" being treated as an escape character
5525c on SGI Fortran compilers
5526      character BSLAS1*(*), BSLASH
5527      parameter (BSLAS1 = '\\')
5528      parameter (BSLASH = BSLAS1(1:1))
5529      character*(*) BFMT1
5530      parameter (BFMT1='('' '//BSLASH//
5531     1'mfsrc{''/'' pickup pencircle scaled '',F6.3,''pt;''/'' for x='',
5532     2F10.3, '' step '', F10.3, '' until '', F11.3, '':'')')
5533c
5534   20 format('  draw(x, ',F11.3,')*pt..(x, ',F11.3,')*pt;'/' endfor;}')
5535   30 format('  draw(',F11.3,', x)*pt..(',F11.3,', x)*pt;'/' endfor;}')
5536   40 format('  for j = 2 upto 9:'/'   y:=x+',F11.3,'*mlog j;'/
5537     1 '   exitif y>', F11.3, ';' /'  if y>=', F11.3, ':')
5538   50 format('  draw(y, ',F11.3,')*pt..(y, ',F11.3,')*pt;'/
5539     1  '  fi' / '  endfor;'/'  endfor;}')
5540   60 format('  draw(',F11.3,', y)*pt..(',F11.3,', y)*pt;'/
5541     1  '  fi' / '  endfor;'/'  endfor;}')
5542C++ CODE for .C. is inactive
5543C%%  const char fmt10[]=" \\mfsrc{\n pickup pencircle scaled %6.3fpt;\n\
5544C%% for x=%10.3f step %10.3f until %11.3f:\n";
5545C%%   const char fmt20[]="  draw(x, %11.3f)*pt..(x, %11.3f)*pt;\n\
5546C%% endfor;}\n";
5547C%%   const char fmt30[]="  draw(%11.3f, x)*pt..(%11.3f, x)*pt;\n\
5548C%% endfor;}\n";
5549C%%   const char fmt40[]="  for j = 2 upto 9:\n   y:=x+%11.3f*mlog j;\n\
5550C%%   exitif y>%11.3f;\n  if y>=%11.3f:\n";
5551C%%   const char fmt50[]="  draw(y, %11.3f)*pt..(y, %11.3f)*pt;\n  fi\n\
5552C%% endfor;\n  endfor;}\n";
5553C%%   const char fmt60[]="  draw(%11.3f, y)*pt..(%11.3f, y)*pt;\n  fi\n\
5554C%% endfor;\n  endfor;}\n";
5555C++ END
5556
5557c
5558      if (STRLOG .lt. 0.D0) then
5559c                           Regular ticks
5560C%%      fprintf(iofil, fmt10, penwid, base, step, till);
5561         write(IOFIL, BFMT1) PENWID, BASE, STEP, TILL
5562         if (IAX .eq. 1) then
5563C%%         fprintf(iofil, fmt20, tbeg, tend);
5564            write (IOFIL, 20) TBEG, TEND
5565         else
5566C%%         fprintf(iofil, fmt30, tbeg, tend);
5567            write (IOFIL, 30) TBEG, TEND
5568         end if
5569      else
5570c                           Logarithmic ticks
5571C%%      fprintf(iofil, fmt10, penwid, base - step, step, till);
5572         write(IOFIL, BFMT1) PENWID, BASE-STEP, STEP, TILL
5573C%%      fprintf(iofil, fmt40, .00169646282*step, till, strlog);
5574         write(IOFIL, 40) .00169646282*STEP, TILL, STRLOG
5575         if (IAX .eq. 1) then
5576C%%         fprintf(iofil, fmt50, tbeg, tend);
5577            write (IOFIL, 50) TBEG, TEND
5578         else
5579C%%         fprintf(iofil, fmt60, tbeg, tend);
5580            write (IOFIL, 60) TBEG, TEND
5581         end if
5582      end if
5583      return
5584      end
5585
5586c==================================================     DPLOT9     =====
5587      subroutine DPLOT9
5588c                       Finish the plot.
5589c
5590c *************************** Internal Variables ***********************
5591c
5592c IFIN    Points to place where text in START starts for a give value
5593c   in IPLOT.  (Only 0 and 1 supported.)
5594c FIN     TeX command to write at the end -- \end{mfpic} or \endmfpic.
5595c
5596c **************************** Variable Declarations *******************
5597c
5598      integer IFIN(0:2)
5599c
5600c Common
5601c  For DPLOT0
5602      double precision ARRLEN, PXO, PXSIZE, PYO, PYSIZE
5603C++ CODE for ~.C. is active
5604      integer IOFIL, IPLOT, KURPEN, LASPEN
5605      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5606     1   IOFIL, IPLOT, KURPEN, LASPEN
5607C++ CODE for .C. is inactive
5608C      integer IPLOT, KURPEN, LASPEN
5609C      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5610C     1   IPLOT, KURPEN, LASPEN
5611C++ END
5612      save /DPLOTD/
5613c
5614      character FIN*20
5615C++ CODE for ~.C. is active
5616c Weird stuff to take care of "\" being treated as an escape character
5617c on SGI Fortran compilers
5618      character BSLAS1*(*), BSLASH
5619      parameter (BSLAS1 = '\\')
5620      parameter (BSLASH = BSLAS1(1:1))
5621c
5622      character*(*) BFMT1
5623      parameter (BFMT1='(1X,A,''{'//BSLASH//
5624     1  'hskip '',F9.3,''pt'//BSLASH//'relax}%'')')
5625      character PFIN*20
5626      parameter (PFIN=BSLASH//'end{mfpic}'//BSLASH//'endmfpic')
5627      data FIN / PFIN /
5628C++ CODE for .C. is inactive
5629CC                 123456789012345678901
5630C      data FIN / '\end{mfpic}\endmfpic' /
5631C%%    const char fmt10[]=" %.*s{\\hskip %9.3fpt\\relax}%%\n";
5632C++ END
5633      data IFIN / 1, 12, 21 /
5634c  Format below works for both TeX and LaTeX  (LaTeX could use \hspace).
5635c
5636c *********     Executable Statements     ******************************
5637
5638      if (IPLOT .lt. 0) then
5639         IPLOT = -100 - IPLOT
5640         if (IPLOT .gt. 1) return
5641C%%      fprintf(iofil, fmt10, (int)(ifin[dplotd.iplot+1]-
5642C%%       ifin[dplotd.iplot]), fin+ifin[dplotd.iplot]-1,
5643C%%       -dplotd.pxo - dplotd.pxsize);
5644      write (IOFIL, BFMT1) FIN(IFIN(IPLOT):IFIN(IPLOT+1)-1),-PXO-PXSIZE
5645         call DPLOT0
5646      else
5647C%%      fprintf(iofil, " %.*s\n", (int)(ifin[dplotd.iplot+1] -
5648C%%         ifin[dplotd.iplot]), fin + ifin[dplotd.iplot] - 1);
5649         write (IOFIL, '(1X,A)') FIN(IFIN(IPLOT):IFIN(IPLOT+1)-1)
5650      end if
5651      return
5652      end
5653
5654c==================================================     DPLOTL     =====
5655      subroutine DPLOTL (MANY, X, Y)
5656
5657c     Plot a line through a sequence of points.
5658
5659c>> 1996-12-18 DPLOTL Snyder  Initial code for MFPIC
5660
5661c MANY [in] Defines action
5662c   .le. 0  End previous curve if any -- X and Y not used.  Then
5663c       if -1 start a new open curve.
5664c       if -2 start a new closed curve.
5665c       if -3 start a curve that is closed with a straight line.
5666c       if -4 start a new polyline.
5667c       if -5 start a new polygon.
5668c   > 0     Output for plotting of MANY points.
5669c   No message is produced if MANY <= 0 twice in a row -- the second
5670c   MANY is used silently.
5671c X [in] is an array of one or more abscissae.
5672c Y [in] is an array of one or more ordinates.  The number of ordinates
5673c        must be the same as the number of abscissae.
5674
5675      integer MANY
5676      double precision X(*), Y(*)
5677
5678c     *****     External References     ********************************
5679
5680c ERMSG   Print error messages.
5681
5682c     *****     Local Variables     ************************************
5683
5684c FORMAT  output format when finishing a curve.
5685c I       is a loop inductor and subscript.
5686c IXPREF  index of PREFIX and LPREFX to use.
5687c K       count of items to print.
5688c LPREFX  Points to start of text in PREFIX, for various cases.
5689c IOFIL*  The logical unit number to use for plot output.
5690c OLDX, OLDY the last X and Y value on the previous call.
5691c PREFIX  Character strings used for headers.
5692c STATE   The number of points saved.  If -1, no curve is started.
5693c         Else 0 <= STATE <= 3.
5694
5695      integer I, IXPREF, K, LPREFX(-5:1)
5696      save IXPREF, LPREFX
5697      double precision OLDX(3), OLDY(3)
5698      save OLDX, OLDY
5699      integer STATE
5700      save STATE
5701c Common
5702c  For DPLOT0
5703      double precision ARRLEN, PXO, PXSIZE, PYO, PYSIZE
5704C++ CODE for ~.C. is active
5705      integer IOFIL, IPLOT, KURPEN, LASPEN
5706      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5707     1   IOFIL, IPLOT, KURPEN, LASPEN
5708C++ CODE for .C. is inactive
5709C      integer IPLOT, KURPEN, LASPEN
5710C      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5711C     1   IPLOT, KURPEN, LASPEN
5712C++ END
5713      save /DPLOTD/
5714
5715c     *****     Data Statements     ************************************
5716
5717C++ CODE for ~.C. is active
5718      character*(62) FORMAT(3)
5719      save FORMAT
5720      data FORMAT /
5721     1'(a,''('',f9.4,'','',f9.4,'')}'')' ,
5722     2'(a,''('',f9.4,'','',f9.4,''),('',f9.4,'','',f9.4,'')}'')',
5723     3'(a,''('',f9.4,'','',f9.4,'')'',2('',('',f9.4,'','',f9.4,'')''),
5724     4''}'')'/
5725C++ END
5726c
5727      character PREFIX*48
5728C++ CODE for (HOW==MFPIC) & ~.C. is ACTIVE
5729c Weird stuff to take care of "\" being treated as an escape character
5730c on SGI Fortran compilers
5731      character BSLAS1*(*), BSLASH
5732      parameter (BSLAS1 = '\\')
5733      parameter (BSLASH = BSLAS1(1:1))
5734c
5735      character PPREFX*48
5736      parameter (PPREFX=BSLASH//'polygon{'//BSLASH//'lines{'//BSLASH//
5737     1  'lclosed '//BSLASH//'curve{'//BSLASH//'cyclic{'//BSLASH//
5738     2  'curve{,')
5739      data PREFIX / PPREFX /
5740C++ CODE for (HOW==MFPIC) & .C. is INACTIVE
5741CC                            1111111111222222222233333333334444444444
5742CC                   1234567890123456789012345678901234567890123456789
5743C      data PREFIX /'\polygon{\lines{\lclosed \curve{\cyclic{\curve{,'/
5744C++ END
5745      data STATE /-1/
5746      data LPREFX / 1, 10, 17, 33, 41, 48, 49 /
5747C++ CODE for ~.C. is active
5748   10 format (a, '(', f9.4, ',', f9.4, ')',2(',(', f9.4, ',', f9.4, ')'
5749     1:)/(3(',(', f9.4, ',', f9.4, ')')))
5750C++ END
5751
5752c     *****     Executable Statements     ******************************
5753
5754      if (MANY .le. 0) then
5755C++ CODE for ~.C. is active
5756        if (STATE .gt. 0) write (IOFIL, FORMAT(STATE))
5757     1     PREFIX(LPREFX(IXPREF):LPREFX(IXPREF+1)-1),
5758     2     (OLDX(I), OLDY(I), I = 1, STATE)
5759C++ CODE for .C. is inactive
5760C%%     if (state > 0){
5761C%%        fprintf(iofil, "%.*s", (int)(lprefx[ixpref+6] -
5762C%%        lprefx[ixpref+5]), prefix+lprefx[ixpref+5]-1);
5763C%%        for (i = 0; i < state; i++) {
5764C%%           if (i != 0) fprintf(iofil, ",");
5765C%%           fprintf(iofil, "(%9.4f,%9.4f)", oldx[i], oldy[i]);}
5766C%%        fprintf(iofil, "}\n");}
5767C++ END
5768        IXPREF = MANY
5769        STATE = 0
5770        if (MANY .eq. 0) STATE = -1
5771      else if (STATE .ge. 0) then
5772        K = MANY - 1 - mod(MANY + STATE - 1, 3)
5773        if (STATE + K .ge. 3) then
5774C++ CODE for ~.C. is active
5775          write (IOFIL, 10) PREFIX(LPREFX(IXPREF):LPREFX(IXPREF+1)-1),
5776     1      (OLDX(I), OLDY(I), I = 1, STATE), (X(I), Y(I), I = 1, K)
5777C++ CODE for .C. is inactive
5778C%%        fprintf(iofil, "%.*s", (int)(lprefx[ixpref+6] -
5779C%%        lprefx[ixpref+5]), prefix+lprefx[ixpref+5]-1);
5780C%%        for (i = 0; i < state; i++) {
5781C%%           if (i != 0) {
5782C%%             if (i%3 == 0) fprintf(iofil, "\n");
5783C%%             fprintf(iofil, ",");}
5784C%%           fprintf(iofil, "(%9.4f,%9.4f)", oldx[i], oldy[i]);}
5785C%%        for (i = 0; i < k; i++) {
5786C%%           if (i + state != 0) {
5787C%%             if ((i+state)%3 == 0) fprintf(iofil, "\n");
5788C%%             fprintf(iofil, ",");}
5789C%%           fprintf(iofil, "(%9.4f,%9.4f)", x[i], y[i]);}
5790C%%        fprintf(iofil, "\n");
5791C++ END
5792          IXPREF = 0
5793          STATE = 0
5794        end if
5795        do 50 I = max(K,0) + 1, MANY
5796          STATE = STATE + 1
5797          OLDX(STATE) = X(I)
5798          OLDY(STATE) = Y(I)
579950      continue
5800      else
5801         stop
5802     1     'DPLOTL (Internal bug) Adding points without initialization.'
5803      end if
5804      return
5805      end
5806
5807c==================================================     DPLOTS     =====
5808      subroutine DPLOTS (XY, KSYMB)
5809c Plot a symbol or error bars or vectors at (XY(1), XY(2).  XY contains
5810c extra data for error bars or vectors as follows:
5811c For error bars:
5812c  XY(1:2) is the mid point.
5813c  XY(3:4) is the bottom.
5814c  XY(5:6) is the top.
5815c For Arrows:
5816c  XY(1:2) is the tail.
5817c  XY(3:4) is the head.
5818c
5819c KSYMB is an integer with digit defining what is to be drawn.
5820c   KSYMB = i1 + 10 * (i2 + 10 * (i3 + 10 * (i4 + 10*i5)))
5821c   if (i2 is not 1) then
5822c      i1 is number of vertices for a polygon
5823c      i2 is the number to "skip" when drawing the symbol
5824c      i3 defines angle of rotation for the first point - 45 * i3 / i1.
5825c      i4 width of line to use in drawing, in deci-points.
5826c      i5 The diameter of the circle, if 0, 6 is used.
5827c   else if (i1 is 0 or 1) then   (let i5 = i6 = 10 * i7)
5828c      i3 length of horizontal line for top/bottom error bar in points.
5829c      i4 length of horizontal line in middle in points.
5830c      i6 width in deci-points for the cross hatch lines.
5831c      i7 width in deic-points for the vertical line, if 0, 3 is used.
5832c   else                          (let i5 = i6 = 10 * i7)
5833c      i3 length of the arrow head for an arrow.
5834c      i4 size of circle in points to be drawn at the tail of the arrow.
5835c      i6 width in decipoints for line used to draw the circle.
5836c      i7 width in decipoints of the line use to draw the arrow.
5837c   end if
5838c
5839c ****************  Variables Definitions ******************************
5840c
5841c A     Angle of current vertex, in degrees.
5842c A0    Angle of initial vertex, in degrees.
5843c AI    Angle increment, in degrees.
5844c ARRLEN* Length of an arrow head.
5845c ARRLOC  Local length of arrow head.
5846c BARMID  Length of middle bar for error bars.
5847c BTBARS  Legth of top and bottom bars for error bars.
5848c CLEAR   Logical variable set = .true. when symbol is drawn twice, the
5849c       time to clear the space, before drawing the symbol.
5850c CLEARI  The initial value used for CLEAR.
5851c COMMA Either ',' or ' ', depending on whether the last point in a
5852c       polygon or line is being emitted.
5853c D2R   Degrees to radians.
5854c IGCD  The gcd of (NVERT, NSKIP).
5855c I, J, K  Loop inductors.
5856c KPENDF  Default value used for KURPEN.
5857c KURPEN* Line width parameter, from KSYMB.
5858c LOCPEN The pen width saved for symbols.
5859c LPENA   Value of KURPEN for line used to draw an arrow.
5860c LPENC   Value of KURPEN for line used to draw an circle for vector
5861c    fields.
5862c LPENH   Value of KURPEN for line used to draw an horizontal lines for
5863c    error bars.
5864c LPENV   Value of KURPEN for line used to draw an vertical lines for
5865c    error bars.
5866c NP    Number of points to plot.
5867c NSKIP Number of vertices to skip, from KSYMB.
5868c NVERT Number of vertices, from KSYMB.
5869c R     Circumcircle radius, 0.5 * max(W, SIZE-W)
5870c ROTATE Amount the first point is rotated from the positive x-axis.
5871c SIZCIR  Diameter of circle use for vector fields.
5872c WW    0.01 * KURPEN = line width in points.
5873c XA, YA  Average of XMAX, XMIN etc.
5874c XMAX, XMIN, YMAX, YMIN  Obvious.
5875c XW, YW  Working values for X and Y.
5876c
5877c Formals
5878      double precision XY(*)
5879      integer KSYMB
5880c Common
5881c  For DPLOT0
5882      double precision ARRLEN, PXO, PXSIZE, PYO, PYSIZE
5883C++ CODE for ~.C. is active
5884      integer IOFIL, IPLOT, KURPEN, LASPEN
5885      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5886     1   IOFIL, IPLOT, KURPEN, LASPEN
5887C++ CODE for .C. is inactive
5888C      integer IPLOT, KURPEN, LASPEN
5889C      common / DPLOTD / ARRLEN, PXO, PXSIZE, PYO, PYSIZE,
5890C     1   IPLOT, KURPEN, LASPEN
5891C++ END
5892      save /DPLOTD/
5893c Locals
5894      logical CLEAR, CLEARI
5895      character COMMA
5896      integer I, IGCD, J, K, KPENDF, LOCPEN, LPENA, LPENC, LPENH, LPENV,
5897     1   LSYMB, NP, NSKIP, NVERT
5898      double precision A, A0, AI, ARRLOC, BARMID, BTBARS, D2R, DIAMET,
5899     1   R, ROTATE, SIZCIR, WW, XA, XMAX, XMIN, XW, YA, YMAX, YMIN, YW
5900      save ARRLOC, BARMID, BTBARS, CLEARI, DIAMET, LPENA, LPENC, LPENH,
5901     1   LPENV, LOCPEN, LSYMB, NSKIP, NVERT, ROTATE, SIZCIR
5902      parameter (KPENDF = 30)
5903      parameter (D2R=.01745329251994329576923690768488612713442871889d0)
5904c
5905      data LSYMB / -1 /
5906c
5907c
5908C++ CODE for ~.C. is active
5909c Weird stuff to take care of "\" being treated as an escape character
5910c on SGI Fortran compilers
5911      character BSLAS1*(*), BSLASH
5912      parameter (BSLAS1 = '\\')
5913      parameter (BSLASH = BSLAS1(1:1))
5914      character*(*) BFMT1, BFMT3
5915      parameter (BFMT1='('' '//BSLASH//
5916     1  'circle{('', F10.3, '','', F10.3, ''),'', F10.3,''}'')',
5917     2  BFMT3='('' '//BSLASH//
5918     3  'lines{('',F12.5,'','',F12.5,''),'',''('',F12.5,'','',F12.5,
5919     4'')}'')')
5920   20 format (2x, '(', f12.5, ',', f12.5, ')', a)
5921      character*(*) BFILL, BCLEAR, BPOLY, BLINES
5922      parameter (BFILL='('' '//BSLASH//'gfill'')',
5923     1  BCLEAR= '('' '//BSLASH//'gclear'')',
5924     2  BPOLY= '('' '//BSLASH//'polygon{'')',
5925     2  BLINES= '('' '//BSLASH//'lines{'')')
5926C++ CODE for .C. is inactive
5927C%%  const char fmt10[]=" \\circle{(%10.3f,%10.3f),%10.3f}\n";
5928C%%  const char fmt20[]="  (%12.5f,%12.5f)%c\n";
5929C%%  const char fmt30[]=" \\lines{(%12.5f,%12.5f),(%12.5f,%12.5f)}\n";
5930C++ END
5931c
5932c *********     Executable Statements     *****************************
5933c
5934      if (KSYMB .ne. LSYMB) then
5935c                           Unpack the data.
5936         LSYMB = KSYMB
5937         K = LSYMB
5938         NVERT = mod(K, 10)
5939         K = K / 10
5940         NSKIP = mod(K, 10)
5941         K = K / 10
5942         if (NVERT .ne. 1) then
5943c                           Got a symbol
5944            if (NVERT .ne. 0) ROTATE = dble(mod(K, 10)*45) / dble(NVERT)
5945            K = K / 10
5946            LOCPEN = 10*mod(K, 10)
5947            if (LOCPEN .eq. 0) then
5948               LOCPEN = KPENDF
5949            else if (LOCPEN .eq. 90) then
5950               LOCPEN = 0
5951            end if
5952            DIAMET = dble(K / 10)
5953            CLEARI = .false.
5954            if (DIAMET .ge. 100.D0) then
5955               DIAMET = mod(DIAMET, 100.D0)
5956               CLEARI = .true.
5957            end if
5958            if (DIAMET .eq. 0.D0) DIAMET = 6.D0
5959         else if (NSKIP .le. 1) then
5960c                               Error Bars -- two types
5961            BTBARS = mod(K, 10)
5962            K = K / 10
5963            BARMID = mod(K, 10)
5964            K = K / 10
5965            LPENH = 10 * mod(K, 10)
5966            LPENV = 10 * (K / 10)
5967         else if (NSKIP .eq. 2) then
5968c                               Vector field
5969            ARRLOC = mod(K, 10)
5970            K = K / 10
5971            SIZCIR = mod(K, 10)
5972            K = K / 10
5973            LPENC = 10 * mod(K, 10)
5974            if (LPENC .eq. 0) LPENC = 20
5975            LPENA = 10 * (K / 10)
5976         else
5977c              Perhaps do text in the future?
5978            return
5979         end if
5980      end if
5981      if (NVERT .ne. 1) then
5982         CLEAR = CLEARI
5983         KURPEN = LOCPEN
5984         call DPLOT1
5985  100    WW = .01D0 * dble(LOCPEN)
5986         R = .5D0 * max(WW, DIAMET - WW)
5987         if (NVERT .eq. 0) then
5988            if (LOCPEN .eq. 0) then
5989C%%            fprintf(iofil, " \\gfill\n");
5990               write (IOFIL, BFILL)
5991               CLEAR = .false.
5992            else if (CLEAR) then
5993C%%            fprintf(iofil, " \\gclear\n");
5994               write (IOFIL, BCLEAR)
5995            end if
5996C%%         fprintf(iofil, fmt10, xy[0], xy[1], r);
5997            write (IOFIL, BFMT1) XY(1), XY(2), R
5998         else
5999            AI = dble((NSKIP+1)*360) / dble(NVERT)
6000            if (NSKIP .gt. NVERT) then
6001               NSKIP = NVERT
6002               IGCD = NVERT
6003            else
6004c                         Get the GCD of NSKIP, NVERT
6005               IGCD = NSKIP + 1
6006               K = NVERT
6007  120          I = mod(K, IGCD)
6008               if (I .ne. 0) then
6009                  K = IGCD
6010                  IGCD = I
6011                  go to 120
6012               end if
6013            end if
6014            NP = NVERT / IGCD
6015            XA = 0.0
6016            YA = 0.0
6017            XMAX = 0.0
6018            XMIN = 0.0
6019            YMAX = 0.0
6020            YMIN = 0.0
6021            do 400 K = 1, 2
6022c                                 K = 1 => get XMIN etc; K = 2 => draw.
6023               A0 = ROTATE
6024               do 300 I = 1, IGCD
6025                 if (K .eq. 2) then
6026                    if (NSKIP .ne. NVERT) then
6027                       if (NP .ne. 2) then
6028                          if (LOCPEN .eq. 0) then
6029C%%                           fprintf(iofil, " \\gfill\n");
6030                              write (IOFIL, BFILL)
6031                          else if (CLEAR) then
6032C%%                           fprintf(iofil, " \\gclear\n");
6033                              write (IOFIL, BCLEAR)
6034                          end if
6035C%%                       fprintf(iofil, " \\polygon\n");
6036                          write (IOFIL, BPOLY)
6037                       else if (CLEAR) then
6038C%%                       fprintf(iofil, " \\gclear\n");
6039                          write (IOFIL, BCLEAR)
6040C%%                       fprintf(iofil, fmt10, xy[0], xy[1], r);
6041                          write (IOFIL, BFMT1) XY(1), XY(2), R
6042                          go to 400
6043                       else
6044C%%                       fprintf(iofil, " \\lines\n");
6045                          write (IOFIL, BLINES)
6046                       end if
6047                    else if (CLEAR) then
6048C%%                    fprintf(iofil, fmt10, xy[0], xy[1], r);
6049                       write (IOFIL, BFMT1) XY(1), XY(2), R
6050                       go to 400
6051                    end if
6052                 end if
6053                 A = A0
6054                 COMMA = ','
6055                 do 200 J = 1, NP
6056                    XW = XA + R * cos(D2R*A)
6057                    YW = YA + R * sin(D2R*A)
6058                    if (K .eq. 1) then
6059                       XMIN = min(XMIN, XW)
6060                       XMAX = max(XMAX, XW)
6061                       YMIN = min(YMIN, YW)
6062                       YMAX = max(YMAX, YW)
6063                    else
6064                       if (NSKIP .ne. NVERT) then
6065                          if (J .eq. NP) comma = ' '
6066C%%                       fprintf(iofil, fmt20, xw, yw, comma);
6067                          write (IOFIL, 20) XW, YW, COMMA
6068                       else
6069C%%                       fprintf(iofil, fmt30, xa, ya, xw, yw );
6070                          write (IOFIL, BFMT3) XA, YA, XW, YW
6071                       end if
6072                    end if
6073                    A = A + AI
6074200              continue
6075                 if ((K .eq. 2) .and. (NSKIP .ne. NVERT)) then
6076C%%                 fprintf(iofil, "  }\n");
6077                    write (IOFIL, '(2X,''}'')')
6078                 end if
6079                 A0 = A0 + (360.D0 / NVERT)
6080300            continue
6081               XA = XY(1) - 0.5D0 * (XMIN + XMAX)
6082               YA = XY(2) - 0.5D0 * (YMIN + YMAX)
6083400        continue
6084         end if
6085         if (CLEAR .and. (LOCPEN .ne. 0)) then
6086            CLEAR = .false.
6087            go to 100
6088         end if
6089      else if (NSKIP .le. 1) then
6090c                           Error bars.
6091         KURPEN = LPENV
6092         call DPLOT2(XY(3), XY(4), XY(5), XY(6))
6093         if (LPENH .ne. 0) then
6094            KURPEN = LPENH
6095            XA = XY(1) - .5D0 * BTBARS
6096            XW = XY(1) + .5D0 * BTBARS
6097            call DPLOT2(XA, XY(4), XW, XY(4))
6098            call DPLOT2(XA, XY(6), XW, XY(6))
6099            call DPLOT2(XY(1)-.5D0*BARMID,XY(2),XY(1)+.5D0*BARMID,XY(2))
6100         end if
6101      else
6102c                           Draw arrows.
6103         ARRLEN = ARRLOC
6104         KURPEN = LPENA
6105         XW = XY(1)
6106         YW = XY(2)
6107         if (SIZCIR .ne. 0.D0) then
6108           R = SIZCIR / sqrt((XY(3)-XW)**2 + (XY(4)-YW)**2)
6109           XW = XW + R * (XY(3) - XW)
6110           YW = YW + R * (XY(4) - YW)
6111         end if
6112         call DPLOT2(XW, XW, XY(3), XY(4))
6113         if (SIZCIR .ne. 0.D0) then
6114c                             Add a little circle.
6115            KURPEN = LPENC
6116            if (LPENC .eq. 90) then
6117C%%            fprintf(iofil, " \\gfill\n");
6118               write (IOFIL, BFILL)
6119               KURPEN = 0
6120            end if
6121            call DPLOT1
6122C%%         fprintf(iofil, fmt10, xy[0], xy[1], sizcir);
6123            write (IOFIL, BFMT1) XY(1), XY(2), SIZCIR
6124         end if
6125      end if
6126      return
6127      end
6128
6129
6130