diff options
| author | Joe Hunkeler <jhunkeler@gmail.com> | 2015-08-11 16:51:37 -0400 |
|---|---|---|
| committer | Joe Hunkeler <jhunkeler@gmail.com> | 2015-08-11 16:51:37 -0400 |
| commit | 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 (patch) | |
| tree | 4464880c571602d54f6ae114729bf62a89518057 /sys/gio/ncarutil/autograph | |
| download | iraf-osx-40e5a5811c6ffce9b0974e93cdd927cbcf60c157.tar.gz | |
Repatch (from linux) of OSX IRAF
Diffstat (limited to 'sys/gio/ncarutil/autograph')
56 files changed, 9663 insertions, 0 deletions
diff --git a/sys/gio/ncarutil/autograph/README b/sys/gio/ncarutil/autograph/README new file mode 100644 index 00000000..befb5e42 --- /dev/null +++ b/sys/gio/ncarutil/autograph/README @@ -0,0 +1,46 @@ +AUTOGRAPH -- This directory contains the contents of the NCAR file +autograph.f, unpacked one subroutine per file. Here is the revision file +supplied by NCAR for the autograph package. For NOAO specific enhancements, +see gio$ncarutil/README. + + Revision history: + + February, 1979 Added a revision history and enhanced machine + independency. + + September, 1979 Fixed a couple of problems which caused the code to + bomb when core was pre-set to indefinites and the + 1st graph drawn was peculiar in some way and another + which caused it to set the default dashed-line-speci- + fier length wrong. Added new documentation. + + October, 1979 Changed the way IDIOT behaves when NPTS is negative. + + March, 1980 Fixed a couple of small errors, one which prevented + an error exit in AGSETP from ever being reached and + another which caused AUTOGRAPH to blow up when given + a zero or negative on a logarithmic axis. Changed + the way in which NBPF is computed by AGSTR1. + + August, 1981 Removed all calls setting the plotter intensity and + made the computation of the variable SMRL portable. + + April, 1984 Made the code strictly FORTRAN-77 compatible, taking + out all dependency on support routines (such as LOC). + This required some changes in the user interface. + + February, 1985 Put code in AGSETP to reclaim character-store space + used by character-string dash patterns when they are + redefined using binary patterns. Also changed AGGTCH + to return a single blank for a non-existent string. + + August, 1985 Put code in AGGETP so that the label-name identifier + is now returned properly. Among other things, this + cures a problem which caused the character-storage + space to be eaten up. + + December, 1985 Fixed AGSETP to zero the current-line pointer when + the current-label pointer is changed. + + January, 1986 Fixed AGAXIS to respond properly to the zeroing of + NCIM by AGCHNL. diff --git a/sys/gio/ncarutil/autograph/agaxis.f b/sys/gio/ncarutil/autograph/agaxis.f new file mode 100644 index 00000000..4c3bec73 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agaxis.f @@ -0,0 +1,1851 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C A B R I E F D E S C R I P T I O N O F A U T O G R A P H +C --------------------------------------------------------------------- +C +C Following is a brief description of the AUTOGRAPH package. For a +C complete write-up, see the document "AUTOGRAPH - THE UNABRIDGED +C WRITE-UP". +C +C +C PACKAGE AUTOGRAPH +C +C LATEST REVISION January, 1986 +C +C PURPOSE To draw graphs, each with a labelled background +C and each displaying one or more curves. +C +C ACCESS (ON THE CRAY) To use AUTOGRAPH routines on the Cray, simply +C call them; they are in the binary library +C $NCARLB, which is automatically searched. +C +C To get smoother curves, drawn using spline +C interpolation, compile DASHSMTH, from ULIB, +C to replace DASHCHAR, from $NCARLB: +C +C GETSRC,LIB=ULIB,FILE=DASHSMTH,L=DSMTH. +C CFT,I=DSMTH,L=0. +C +C AUTOGRAPH contains a routine AGPWRT, which it +C calls to draw labels. This routine just passes +C its arguments on to the system-plot-package +C routine PWRIT. To use one of the fancier +C character-drawers, like PWRITX or PWRITY, +C just compile a routine AGPWRT to replace the +C default version; it has the same arguments as +C PWRIT and may either draw the character string +C itself, or just pass the arguments on to a +C desired character-drawer. The AUTOGRAPH +C specialist has some "standard" versions of +C AGPWRT and should be consulted for help in +C avoiding pitfalls. One standard version, +C which calls PWRITX, may be obtained using the +C following JCL: +C +C GETSRC,LIB=XLIB,FILE=AGUPWRITX,L=UPWRTX. +C CFT,I=UPWRTX,L=0. +C +C USAGE Following this indented preamble are given two +C lists: one describing the AUTOGRAPH routines +C and another describing the arguments of those +C routines. +C +C "AUTOGRAPH - THE UNABRIDGED WRITE-UP" gives +C a complete write-up of AUTOGRAPH, in great +C detail and with a set of helpful examples. +C +C ENTRY POINTS Except for seven routines which are included +C in the package for historical reasons (EZY, +C EZXY, EZMY, EZMXY, IDIOT, ANOTAT, and DISPLA), +C the AUTOGRAPH routines have six-character names +C beginning with the characters 'AG'. An alpha- +C betized list follows: +C +C AGAXIS AGBACK AGBNCH AGCHAX AGCHCU AGCHIL +C AGCHNL AGCTCS AGCTKO AGCURV AGDASH AGDFLT +C AGDLCH AGDSHN AGEXAX AGEXUS AGEZSU AGFPBN +C AGFTOL AGGETC AGGETF AGGETI AGGETP AGGTCH +C AGINIT AGKURV AGLBLS AGMAXI AGMINI AGNUMB +C AGPPID AGPWRT AGQURV AGRPCH AGRSTR AGSAVE +C AGSCAN AGSETC AGSETF AGSETI AGSETP AGSRCH +C AGSTCH AGSTUP AGUTOL +C +C NOTE: The "routine" AGDFLT is a block-data +C routine specifying the default values of +C AUTOGRAPH control parameters. +C +C SPECIAL CONDITIONS Under certain conditions, AUTOGRAPH may print +C an error message (via the routine SETER) and +C stop. Each error message includes the name of +C the routine which issued it. A description of +C the condition which caused the error may be +C found in the AUTOGRAPH write-up in the NCAR +C graphics manual; look in the write-up of the +C routine which issued the error message, under +C the heading 'SPECIAL CONDITIONS'. +C +C For error messages issued by the routine +C AGNUMB, see the write-up of the routine AGSTUP. +C +C If you get an error in the routine ALOG10, it +C probably means that you are using a logarithmic +C axis and some of the coordinate data along that +C axis are zero or negative. +C +C COMMON BLOCKS The AUTOGRAPH common blocks are AGCONP, AGORIP, +C AGOCHP, AGCHR1, and AGCHR2. AGCONP contains +C the AUTOGRAPH "control parameters", primary and +C secondary, all of which are real, AGORIP other +C real and/or integer parameters, AGOCHP other +C character parameters, AGCHR1 and AGCHR2 the +C variables implementing the character-storage- +C and-retrieval scheme of AUTOGRAPH. +C +C I/O Lower-level plotting routines are called to +C produce graphical output and, when errors +C occur, error messages may be written to the +C system error file, as defined by I1MACH(4), +C either directly or by way of a call to SETER. +C +C REQUIRED ULIB AUTOGRAPH uses the software dashed-line package +C ROUTINES DASHCHAR. Of course, either of the packages +C DASHSMTH or DASHSUPR may be used instead, to +C get smoother curves. +C +C SPECIALIST Dave Kennison, Scientific Computing Division, +C National Center for Atmospheric Research +C +C LANGUAGE FORTRAN +C +C HISTORY Dave Robertson wrote the original routine +C IDIOT, which was intended to provide a simple, +C quick-and-dirty, x-y graph-drawing capability. +C In time, as it became obvious that many users +C were adapting IDIOT to more sophisticated +C tasks, Dan Anderson wrote the first AUTOGRAPH +C package, based on IDIOT. It allowed the user +C to put more than one curve on a graph, to use +C more sophisticated backgrounds, to specify +C coordinate data in a variety of ways, and to +C more easily control the scaling and positioning +C of graphs. Eventually, this package, too, was +C found wanting. In 1977, Dave Kennison entirely +C re-wrote AUTOGRAPH, with the following goals: +C to maintain the ease of use for simple graphs +C which had been the principal virtue of the +C package, to provide the user with as much +C control as possible, to incorporate desirable +C new features, and to make the package as +C portable as possible. In 1984, the package +C was again worked over by Dave Kennison, to +C make it compatible with FORTRAN-77 and +C to remove any dependency on the LOC function, +C which had proved to cause difficulties on +C certain machines. The user interface was +C changed somewhat and some new features were +C added. A GKS-compatible version was written. +C +C SPACE REQUIRED AUTOGRAPH is big; one pays a price for its +C capabilities. On the Cray, it occupies a +C little under 30000 (octal) locations. The +C required plot package routines take about +C another 7000 (octal), the (modified) PORT +C support routines about another 1000 (octal), +C and system routines (math, I/O, miscellany) +C another 30000 (octal). +C +C PORTABILITY AUTOGRAPH may be ported with few modifications +C to most systems having a FORTRAN-77 compiler. +C +C The labelled common blocks may have to be +C declared in a part of the user program which +C is always core-resident so that variables +C in them will maintain their values from one +C AUTOGRAPH-routine call to the next. Such a +C problem may arise when AUTOGRAPH is placed in +C an overlay or when some sort of memory-paging +C scheme is used. +C +C REQUIRED RESIDENT AUTOGRAPH uses the DASHCHAR routines DASHDB, +C ROUTINES DASHDC, FRSTD, LASTD, LINED, AND VECTD, the +C system-plot-package routines FRAME, GETSET, +C GETSI, LINE, PWRIT, and SET, the support +C routines ISHIFT and IOR, the (modified) +C PORT utilities SETER and I1MACH, and the +C FORTRAN-library routines ALOG10, ATAN2, COS, +C SIN, AND SQRT. +C +C --------------------------------------------------------------------- +C U S E R - C A L L A B L E A U T O G R A P H R O U T I N E S +C --------------------------------------------------------------------- +C +C Following is a list of AUTOGRAPH routines to be called by the user +C (organized by function). Each routine is described briefly. The +C arguments of the routines are described in the next section. +C +C Each of the following routines draws a complete graph with one call. +C Each is implemented by a set of calls to the lower-level AUTOGRAPH +C routines AGSTUP, AGCURV, and AGBACK (which see, below). +C +C -- EZY (YDRA,NPTS,GLAB) - draws a graph of the curve defined by the +C data points ((I,YDRA(I)),I=1,NPTS), with a graph label specified +C by GLAB. +C +C -- EZXY (XDRA,YDRA,NPTS,GLAB) - draws a graph of the curve defined by +C the data points ((XDRA(I),YDRA(I)),I=1,NPTS), with a graph label +C specified by GLAB. +C +C -- EZMY (YDRA,IDXY,MANY,NPTS,GLAB) - draws a graph of the family of +C curves defined by data points (((I,YDRA(I,J)),I=1,NPTS),J=1,MANY), +C with a graph label specified by GLAB. The order of the subscripts +C of YDRA may be reversed - see the routine DISPLA, argument LROW. +C +C -- EZMXY (XDRA,YDRA,IDXY,MANY,NPTS,GLAB) - draws a graph of the +C family of curves defined by the data points (((XDRA(I),YDRA(I,J)), +C I=1,NPTS),J=1,MANY), with a graph label specified by GLAB. XDRA +C may be doubly-subscripted and the order of the subscripts of XDRA +C and YDRA may be reversed - see the routine DISPLA, argument LROW. +C +C -- IDIOT (XDRA,YDRA,NPTS,LTYP,LDSH,LABX,LABY,LABG,LFRA) - implements +C the routine from which AUTOGRAPH grew - not recommended - provided +C for antique lovers. +C +C The following routines provide user access to the AUTOGRAPH control +C parameters (in the labelled common block AGCONP). +C +C -- ANOTAT (XLAB,YLAB,LBAC,LSET,NDSH,DSHL) - may be used to change the +C x- and y-axis (non-numeric) labels, the background type, the way +C in which graphs are positioned and scaled, and the type of dash +C patterns to be used in drawing curves. +C +C -- DISPLA (LFRA,LROW,LTYP) - may be used to specify when, if ever, +C the EZ... routines do a frame advance, how input arrays for EZMY +C and EZMXY are dimensioned, and the linear/log nature of graphs. +C +C -- AGSETP (TPGN,FURA,LURA) - a general-purpose parameter-setting +C routine, used to set the group of parameters specified by TPGN, +C using values obtained from the array (FURA(I),I=1,LURA). +C +C -- AGSETF (TPGN,FUSR) - used to set the single parameter specified by +C TPGN, giving it the floating-point value FUSR. +C +C -- AGSETI (TPGN,IUSR) - used to set the single parameter specified by +C TPGN, giving it the floating-point value FLOAT(IUSR). +C +C -- AGSETC (TPGN,CUSR) - the character string CUSR is stashed in an +C array inside AUTOGRAPH and the floating-point equivalent of an +C identifier which may be used for later retrieval of the string is +C stored as the value of the single parameter specified by TPGN. The +C single parameter must be a label name, a dash pattern, the text of +C a label line, or the line-terminator character. +C +C -- AGGETP (TPGN,FURA,LURA) - a general-purpose parameter-getting +C routine, used to get the group of parameters specified by TPGN, +C putting the result in the array (FURA(I),I=1,LURA). +C +C -- AGGETF (TPGN,FUSR) - used to get, in FUSR, the floating-point +C value of the single parameter specified by TPGN. +C +C -- AGGETI (TPGN,IUSR) - used to get, in IUSR, the integer equivalent +C of the value of the single parameter specified by TPGN. +C +C -- AGGETC (TPGN,CUSR) - used to get, in CUSR, the character string +C whose identifier is specified by the integer equivalent of the +C single parameter specified by TPGN. The single parameter must +C be a label name, a dash pattern, the text of a label line, or the +C line-terminator character. +C +C The following are lower-level routines, which may be used to draw +C graphs of many different kinds. The EZ... routines call these. They +C are intended to be called by user programs, as well. +C +C -- AGSTUP (XDRA,NVIX,IIVX,NEVX,IIEX,YDRA,NVIY,IIVY,NEVY,IIEY) - this +C routine must be called prior to the first call to either of the +C two routines AGBACK and AGCURV, to force the set-up of secondary +C parameters controlling the behavior of those routines. After any +C parameter-setting call, AGSTUP must be called again before calling +C either AGBACK or AGCURV again. AGSTUP calls the routine "SET", in +C the plot package, so that user x/y coordinates in subsequent calls +C will map properly into the plotter space. +C +C -- AGBACK - draws the background defined by the current state of the +C AUTOGRAPH control parameters. +C +C -- AGCURV (XVEC,IIEX,YVEC,IIEY,NEXY,KDSH) - draws the curve defined +C by the arguments, positioning it as specified by the current state +C of the AUTOGRAPH control parameters. +C +C The following utility routines are called by the user. +C +C -- AGSAVE (IFNO) - used to save the current state of AUTOGRAPH by +C writing the appropriate information to a specified file. Most +C commonly used to save the default state for later restoration. +C This routine should be used instead of AGGETP when the object +C is to save the whole state of AUTOGRAPH, since it saves not only +C the primary control parameters, but all of the character strings +C pointed to by the primary control parameters. It is the user's +C responsibility to position the file before calling AGSAVE. +C +C -- AGRSTR (IFNO) - used to restore a saved state of AUTOGRAPH by +C reading the appropriate information from a specified file. Most +C commonly used to restore AUTOGRAPH to its default state. It is +C the user's responsibility to position the file before calling +C AGRSTR. +C +C -- AGBNCH (IDSH) - a function, of type CHARACTER*16 (it must be +C declared as such in a user routine referencing it), whose value, +C given a 16-bit binary dash pattern, is the equivalent character +C dash pattern. +C +C -- AGDSHN (IDSH) - a function, of type CHARACTER*16 (it must be +C declared as such in a user routine referencing it), whose value, +C given an integer "n" (typically between 1 and 26) is the character +C string 'DASH/ARRAY/nnnn.', which is the name of the nth dash +C pattern parameter. To set the 13th dash pattern, for example, +C one might use "CALL AGSETC (AGDSHN(13),'$$$$$$CURVE 13$$$$$$')". +C +C The following utility routines are called by AUTOGRAPH. The versions +C included in AUTOGRAPH itself are dummies; they do nothing but RETURN. +C The user may replace one or more of these routines with versions to +C accomplish specific purposes. +C +C -- AGUTOL (IAXS,FUNS,IDMA,VINP,VOTP) - called by AUTOGRAPH to perform +C the mapping from user-system values along an axis to label-system +C values along the axis and vice-versa. This routine may be replaced +C by the user to create a desired graph. +C +C -- AGCHAX (IFLG,IAXS,IPRT,VILS) - called by AUTOGRAPH just before and +C just after the various parts of the axes are drawn. +C +C -- AGCHCU (IFLG,KDSH) - called by AUTOGRAPH just before and just after +C each curve is drawn. +C +C -- AGCHIL (IFLG,LBNM,LNNO) - called by AUTOGRAPH just before and just +C after each line of an informational label is drawn. +C +C -- AGCHNL (IAXS,VILS,CHRM,MCIM,NCIM,IPXM,CHRE,MCIE,NCIE) - called by +C AUTOGRAPH just after the character strings defining a numeric label +C have been generated. +C +C --------------------------------------------------------------------- +C D E S C R I P T I O N S O F A R G U M E N T S +C --------------------------------------------------------------------- +C +C In calls to the routines EZY, EZXY, EZMY, and EZMXY: +C +C -- XDRA is an array of x coordinates, dimensioned as implied by the +C current value of the AUTOGRAPH control parameter 'ROW.' (see the +C description of the argument LROW, below). The value of the +C AUTOGRAPH parameter 'NULL/1.' (1.E36, by default) when used as an +C x coordinate, implies a missing data point; the curve segments +C on either side of such a point are not drawn. +C +C -- YDRA is an array of y coordinates, dimensioned as implied by the +C current value of the AUTOGRAPH control parameter 'ROW.' (see the +C description of the argument LROW, below). The value of the +C AUTOGRAPH parameter 'NULL/1.' (1.E36, by default) when used as a +C y coordinate, implies a missing data point; the curve segments +C on either side of such a point are not drawn. +C +C -- IDXY is the first dimension of the arrays XDRA (if it has two +C dimensions) and YDRA. +C +C -- MANY is the number of curves to be drawn by the call to EZ... - +C normally, the second dimension of XDRA (if it has two dimensions) +C and YDRA. +C +C -- NPTS is the number of points defining each curve to be drawn by +C the routine EZ... - normally, the first (or only) dimension of +C XDRA and YDRA. +C +C -- GLAB is a character constant or a character variable, defining a +C label to be placed at the top of the graph. The string may not be +C more than 40 characters long - if it is fewer than 40 characters +C long, its last character must be a dollar sign. (The dollar sign +C is not a part of the label - it is stripped off.) The character +C string "CHAR(0)" may be used to indicate that the previous label, +C whatever it was, should continue to be used. The initial graph +C label consists of blanks. +C +C In calls to the routine ANOTAT: +C +C -- XLAB and YLAB resemble GLAB (see above) and define labels for the +C x and y axes. The default x-axis label is the single character +C X, the default y-axis label the single character Y. Note that one +C may use the string "CHAR(0)" to indicate that the x-axis (y-axis) +C label is not to be changed from what it was previously. +C +C -- LBAC, if non-zero, specifies a new value for the AUTOGRAPH control +C parameter 'BACKGROUND.', as follows: +C +C 1 - a perimeter background +C +C 2 - a grid background +C +C 3 - an axis background +C +C 4 - no background +C +C The default value of 'BACKGROUND.' is 1. +C +C -- LSET, if non-zero, specifies a new value for the AUTOGRAPH control +C parameter 'SET.'. This parameter may be negated to suspend the +C drawing of curves by the EZ... routines, so that a call to one of +C them will produce only a background. The absolute value of 'SET.' +C affects the way in which AUTOGRAPH determines the position and +C shape of the graph and the scaling of the axes, as follows: +C +C 1 - Restores the default values of the AUTOGRAPH parameters +C in question. AUTOGRAPH will set up an appropriate call +C to the plot-package routine "SET", over-riding any prior +C call to that routine. +C +C 2 - Tells AUTOGRAPH to use arguments 1-4 and 9 of the last +C "SET" call. Arguments 1-4 specify where the graph should +C fall on the plotter frame, argument 9 whether the graph +C is linear/linear, linear/log, etc. +C +C 3 - Tells AUTOGRAPH to use arguments 5-8 and 9 of the last +C "SET" call. Arguments 5-8 specify the scaling of the +C axes, argument 9 whether the graph is linear/linear, +C linear/log, etc. +C +C 4 - A combination of 2 and 3. Arguments 1-4 of the last "SET" +C call specify the position, arguments 5-8 the scaling, and +C argument 9 the linear/log nature, of the graph. +C +C (The plot-package routine "SET" is described in the NCAR Graphics +C Manual; it is not a part of AUTOGRAPH.) +C +C If the routine DISPLA is called with its argument LTYP non-zero, +C the linear/log nature of the graph will be that specified by LTYP, +C not that specified by the last "SET" call, no matter what the value +C of the control parameter 'SET.'. +C +C The default value of 'SET.' is 1. +C +C -- NDSH, if non-zero, specifies a new value of the AUTOGRAPH control +C parameter 'DASH/SELECTOR.' (and therefore a new set of dashed-line +C patterns), as described below. Note: The default value of the +C dashed-line parameters is such that all curves will be drawn using +C solid lines; if that is what you want, use a zero for NDSH. +C +C If the value of 'DASH/SELECTOR.' is negative, curves produced +C by subsequent calls to EZMY or EZMXY will be drawn using a +C set of alphabetic dashed-line patterns. The first curve drawn +C by a given call will be labelled 'A', the second 'B', ..., the +C twenty-sixth 'Z', the twenty-seventh 'A' again, and so on. +C Curves drawn by calls to EZY and EZXY will be unaffected. +C +C If the value of 'DASH/SELECTOR.' is positive, it must be less +C than or equal to 26. The next argument, DSHL, is an array +C containing NDSH dashed-line patterns. All curves produced by +C subsequent calls to EZY, EZXY, EZMY, and EZMXY will be drawn +C using the dashed-line patterns in (DSHL(I),I=1,NDSH) - the +C first curve produced by a given call will have the pattern +C specified by DSHL(1), the second that specified by DSHL(2), +C the third that specified by DSHL(3), . . . the NDSH+1st that +C specified by DSHL(1), . . . etc. Each element of DSHL must +C be a character string, in which a dollar sign stands for a +C solid-line segment, a quote stands for a gap, and other +C characters stand for themselves. See the write-up of the +C package "DASHCHAR". Binary dashed-line patterns may not be +C defined by means of a call to ANOTAT, only by means of calls +C to lower-level routines. +C +C -- DSHL (if NDSH is greater than zero) is an array of dashed-line +C patterns, as described above. +C +C In calls to the routine DISPLA: +C +C -- LFRA, if non-zero, specifies a new value for the AUTOGRAPH control +C parameter 'FRAME.'. Possible values are as follows: +C +C 1 - The EZ... routines do a frame advance after drawing. +C +C 2 - No frame advance is done by the EZ... routines. +C +C 3 - The EZ... routines do a frame advance before drawing. +C +C The default value of 'FRAME.' is 1. +C +C -- LROW, if non-zero, specifies a new value for the AUTOGRAPH control +C parameter 'ROW.'. This parameter tells AUTOGRAPH how the argument +C arrays XDRA and YDRA, in calls to the routines EZMY and EZMXY, are +C subscripted, as follows: +C +C If 'ROW.' is positive, this implies that the first subscript +C of YDRA is a point number and the second subscript is a curve +C number. If 'ROW.' is negative, the order is reversed. +C +C If the absolute value of 'ROW.' is 1, this implies that XDRA +C is singly-subscripted, by point number only. If the absolute +C value of 'ROW.' is 2 or greater, this implies that XDRA is +C doubly-subscripted, just like YDRA. +C +C The default value of 'ROW.' is 1, spicifying that XDRA is singly- +C subscripted and that YDRA is doubly-subscripted by point number +C and curve number, in that order. +C +C -- LTYP, if non-zero, specifies new values for the AUTOGRAPH control +C parameters 'X/LOGARITHMIC.' and 'Y/LOGARITHMIC.', which determine +C whether the X and Y axes are linear or logarithmic. Possible +C values are as follows: +C +C 1 - x axis linear, y axis linear +C +C 2 - x axis linear, y axis logarithmic +C +C 3 - x axis logarithmic, y axis linear +C +C 4 - x axis logarithmic, y axis logarithmic +C +C The default values of these parameters make both axes linear. +C +C If the parameters 'X/LOGARITHMIC.' and 'Y/LOGARITHMIC.' are reset +C by the routine DISPLA, they are given values which make them +C immune to being reset when 'SET.' = 2, 3, or 4 (see the discussion +C of the argument LSET, above). +C +C In calls to the routines AGSETP, AGSETF, AGSETI AGSETC, AGGETP, +C AGGETF, AGGETI, and AGGETC: +C +C -- TPGN is a character string identifying a group of AUTOGRAPH +C control parameters. It is of the form 'K1/K2/K3/ . . . /Kn.'. +C Each Ki is a keyword. The keyword K1 specifies a group of control +C parameters, K2 a subgroup of that group, K3 a subgroup of that +C subgroup, etc. See the AUTOGRAPH write-up in the graphics manual +C for a more complete description of these parameter-group names and +C the ways in which they may be abbreviated. +C +C -- FURA is an array, from which control-parameter values are to be +C taken (the routine AGSETP) or into which they are to be stored +C (the routine AGGETP). Note that the array is real; all of the +C AUTOGRAPH parameters are stored internally as reals. +C +C -- LURA is the length of the user array FURA. +C +C -- FUSR is a variable, from which a single control parameter value is +C to be taken (the routine AGSETF) or in which it is to be returned +C (the routine AGGETF). Note that the variable is real. +C +C -- IUSR is a variable, from which a single-control parameter value is +C to be taken (the routine AGSETI) or in which it is to be returned +C (the routine AGGETI). Note that, since the control parameters are +C stored internally as reals, each of the routines AGSETI and AGGETI +C does a conversion - from integer to real or vice-versa. Note also +C that AGSETI and AGGETI should only be used for parameters which +C have intrinsically integral values. +C +C -- CUSR is a character variable from which a character string is to +C be taken (the routine AGSETC) or into which it is to be retrieved +C (the routine AGGETC). The control parameter affected by the call +C contains the floating-point equivalent of an integer identifier +C returned by the routine which stashes the character string and +C tendered to the routine which retrieves it (sort of the automated +C equivalent of a hat check). Note that AGSETC and AGGETC should +C only be used for parameters which intrinsically represent character +C strings. +C +C In calls to the routine AGSTUP: +C +C -- XDRA is an array of x coordinates of user data - usually, but not +C necessarily, the same data which will later be used in calls to +C the routine AGCURV. +C +C -- NVIX is the number of vectors of data in XDRA - if XDRA is doubly- +C dimensioned, NVIX would normally have the value of its second +C dimension, if XDRA is singly-dimensioned, a 1. +C +C -- IIVX is the index increment between vectors in XDRA - if XDRA is +C doubly-dimensioned, IIVX would normally have the value of its +C first dimension, if XDRA is singly-dimensioned, a dummy value. +C +C -- NEVX is the number of elements in each data vector in XDRA - if +C XDRA is doubly-dimensioned, NEVX would normally have the value of +C its first dimension, if XDRA is singly-dimensioned, the value of +C that single dimension. +C +C -- IIEX is the index increment between elements of a data vector in +C XDRA - normally a 1. +C +C -- YDRA, NVIY, IIVY, NEVY, and IIEY are analogous to XDRA, NVIX, +C IIVX, NEVX, and IIEX, but define y-coordinate data. +C +C In calls to the routine AGCURV: +C +C -- XVEC is a vector of x coordinate data. +C +C -- IIEX is the index increment between elements in XVEC. AGCURV will +C use XVEC(1), XVEC(1+IIEX), XVEC(1+2*IIEX), etc. +C +C -- YVEC is a vector of y coordinate data. +C +C -- IIEY is the index increment between elements in YVEC. AGCURV will +C use YVEC(1), YVEC(1+IIEY), YVEC(1+2*IIEY), etc. +C +C -- NEXY is the number of points defining the curve to be drawn. +C +C -- KDSH is a dashed-line selector. Possible values are as follows: +C +C If KDSH is zero, AUTOGRAPH will assume that the user has +C called the routine DASHD (in the DASHCHAR package, which see) +C to define the dashed-line pattern to be used. +C +C If KDSH is less than zero and has absolute value M, AUTOGRAPH +C will use the Mth (modulo 26) alphabetic dashed-line pattern. +C Each of these patterns defines a solid line interrupted every +C so often by a letter of the alphabet. +C +C If KDSH is greater than zero and has the value M, AUTOGRAPH +C will use the Mth (modulo N) dashed-line pattern in the group +C of N dashed-line patterns defined by the AUTOGRAPH control +C parameters in the group named 'DASH/PATTERNS.'. The default +C values of these parameters specify solid lines. +C +C In calls to the routines AGSAVE and AGRSTR: +C +C -- IFNO is the unit number associated with a file to which a single +C unformatted logical record of data is to be written, or from which +C such a record is to be read, by AUTOGRAPH. The file is not rewound +C before being written or read; positioning it properly is the user's +C responsibility. +C +C In calls to the function AGBNCH: +C +C -- IDSH is a 16-bit binary dash pattern, the character equivalent of +C which is to be returned as the value of AGBNCH. +C +C In calls to the function AGDSHN: +C +C -- IDSH is the number of the dash pattern parameter whose name is to +C be returned as the value of the function AGDSHN. +C +C In calls to the routine AGUTOL: +C +C -- IAXS is the number of the axis. The values 1, 2, 3, and 4 imply +C the left, right, bottom, and top axes, respectively. +C +C -- FUNS is the value of the parameter 'AXIS/s/FUNCTION.' which may be +C used to select the desired mapping function for axis IAXS. It is +C recommended that the default value (zero) be used to specify the +C identity mapping. A non-zero value may be integral (1., 2., etc.) +C and serve purely to select the code to be executed or it may be the +C value of a real parameter in the equations defining the mapping. +C +C -- IDMA specifies the direction of the mapping. A value greater than +C zero indicates that VINP is a value in the user system and that +C VOTP is to be a value in the label system, a value less than zero +C the opposite. +C +C -- VINP is an input value in one coordinate system along the axis. +C +C -- VOTP is an output value in the other coordinate system along the +C axis. +C +C In calls to the routine AGCHAX: +C +C -- IFLG is zero if a particular object is about to be drawn, non-zero +C if it has just been drawn. +C +C -- IAXS is the number of the axis being drawn. The values 1, 2, 3, +C and 4 indicate the left, right, bottom, and top axes, respectively. +C +C -- IPRT indicates the part of the axis being drawn. Possible values +C are as follows: +C +C -- 1 implies the line of the axis. +C +C -- 2 implies a major tick. +C +C -- 3 implies a minor tick. +C +C -- 4 implies the mantissa of a numeric label. +C +C -- 5 implies the exponent of a numeric label. +C +C -- VILS is the value in the label system at the point where the part +C is being drawn. For IPRT = 1, VILS is zero. +C +C In calls to the routine AGCHCU: +C +C -- IFLG is zero if a particular object is about to be drawn, non-zero +C if it has just been drawn. +C +C -- KDSH is the value with which AGCURV was called, as follows: +C +C AGCURV called by Value of KDSH +C ---------------- ---------------------------------------- +C EZY 1 +C EZXY 1 +C EZMY "n" or "-n", where n is the curve number +C EZMXY "n" or "-n", where n is the curve number +C the user program the user value +C +C In calls to the routine AGCHIL: +C +C -- IFLG is zero if a particular object is about to be drawn, non-zero +C if it has just been drawn. +C +C -- LBNM is a character variable containing the name of the label being +C drawn. +C +C -- LNNO is the number of the line being drawn. +C +C In calls to the routine AGCHNL: +C +C -- IAXS is the number of the axis being drawn. The values 1, 2, 3, +C and 4 imply the left, right, bottom, and top axes, respectively. +C +C -- VILS is the value to be represented by the numeric label, in the +C label system for the axis. The value of VILS must not be altered. +C +C -- CHRM, on entry, is a character string containing the mantissa of +C the numeric label, as it will appear if AGCHNL makes no changes. +C If the numeric label includes a "times" symbol, it is represented +C by a blank in CHRM. (See IPXM, below.) CHRM may be modified. +C +C -- MCIM is the length of CHRM - the maximum number of characters that +C it will hold. The value of MCIM must not be altered. +C +C -- NCIM, on entry, is the number of meaningful characters in CHRM. If +C CHRM is changed, NCIM should be changed accordingly. +C +C -- IPXM, on entry, is zero if there is no "times" symbol in CHRM; if +C it is non-zero, it is the index of a character position in CHRM. +C If AGCHNL changes the position of the "times" symbol in CHRM, +C removes it, or adds it, the value of IPXM must be changed. +C +C -- CHRE, on entry, is a character string containing the exponent of +C the numeric label, as it will appear if AGCHNL makes no changes. +C CHRE may be modified. +C +C -- MCIE is the length of CHRE - the maximum number of characters that +C it will hold. The value of MCIE must not be altered. +C +C -- NCIE, on entry, is the number of meaningful characters in CHRE. If +C CHRE is changed, NCIE should be changed accordingly. +C +C --------------------------------------------------------------------- +C T H E A U T O G R A P H C O D E +C --------------------------------------------------------------------- +C +C Following is the AUTOGRAPH code. Routines appear in alphabetic order. +C + SUBROUTINE AGAXIS (IAXS,QTST,QSPA,WCWP,HCWP,XBGA,YBGA,XNDA,YNDA, + + QLUA,UBGA,UNDA,FUNS,QBTP,BASE,QJDP,WMJL,WMJR, + + QMNT,QNDP,WMNL,WMNR,QLTP,QLEX,QLFL,QLOF,QLOS, + + DNLA,WCLM,WCLE,RFNL,QCIM,QCIE,WNLL,WNLR,WNLB, + + WNLE) +C +C The routine AGAXIS is used to draw, tick-mark, and label an axis or, +C if ITST is non-zero, to pre-compute the amount of space which will be +C required for numeric labels when the axis is actually drawn. AGAXIS +C assumes that the last call to the plot-package routine SET was as +C follows (or the equivalent thereof): +C +C CALL SET (XLCW,XRCW,YBCW,YTCW,0.,1.,0.,1.,1) +C +C where XLCW, XRCW, YBCW, and YTCW are the coordinates of the left, +C right, bottom, and top edges of the curve window, stated as fractions +C of the appropriate edge of the plotter frame. +C +C The arguments of AGAXIS are as follows: +C +C -- IAXS is the number of the axis being drawn - 1, 2, 3, or 4, meaning +C the left, right, bottom, and top axes, respectively. +C +C -- ITST is an integer specifying what the caller wishes AGAXIS to do, +C as follows: +C +C -- If ITST .LT. 0, AGAXIS is to draw only the axis, nothing else. +C +C -- If ITST .EQ. 0, AGAXIS is to draw, tick, and label the axis. +C +C -- If ITST .GT. 0, AGAXIS is to pre-compute the amount of space +C which will be required for numeric labels. If the labels will +C not fit in the space provided, AGAXIS is instructed to take +C action as follows: +C +C -- ITST .EQ. 1 - no action. +C +C -- ITST .EQ. 2 - shrink the labels. +C +C -- ITST .EQ. 3 - re-orient the labels. +C +C -- ITST .EQ. 4 - shrink and/or re-orient the labels. +C +C -- ISPA is a 0 or a 1, specifying whether or not the axis itself is +C to be drawn. If ISPA .NE. 0, the axis is suppressed. Tick marks +C and/or labels may still be drawn. +C +C -- WCWP is the width of the curve window, in plotter units. +C +C -- HCWP is the height of the curve window, in plotter units. +C +C -- XBGA, YBGA, XNDA, and YNDA are the x and y coordinates of the ends +C of the axis. X coordinates are stated as fractions of the width, +C y coordinates as fractions of the height, of the curve window. The +C axis to be drawn must be either horizontal or vertical (at an angle +C of 0, 90, 180, or 270 degrees). The left side, right side, begin- +C ning, and end of the axis are defined from the viewpoint of a demon +C standing at (XBGA,YBGA) and staring balefully toward (XNDA,YNDA). +C +C -- LLUA, UBGA, and UNDA define the mapping of the "user" coordinate +C system (used for data-point coordinates) onto the axis. If LLUA +C is zero, the mapping is linear; if LLUA is non-zero, the mapping +C is logarithmic. UBGA is the user-system value at the beginning of +C the axis, UNDA the value at the end of the axis. The subroutine +C AGFTOL, which needs these parameters, is actually passed LLUA, +C UBEG=F(UBGA), and UDIF=F(UNDA)-F(UBGA), where F is the function +C F(X)=X or the function F(X)=ALOG10(X), depending on LLUA. +C +C -- FUNS is a function-selector, to be used in calls to AGUTOL, which +C defines the mappings from the user system to the label system and +C vice-versa for each of the four axes. The functions defined must +C be continuous, monotonic, and bounded within the user-system range +C (UBGA,UNDA) and a little bit outside that range. The positions +C of numeric labels and tick marks are chosen in the label system, +C mapped to the user system, and then onto the axis. +C +C -- NBTP and BASE specify how major ticks are to be positioned in the +C label coordinate system. See the routine AGNUMB (arguments NBTP, +C SBSE, and EXMU) for a description of these arguments. Note that +C NBTP .EQ. 0 or BASE .EQ. 0. suppresses both major tick marks and +C their labels. Note: SBSE .EQ. +BASE or -BASE, as needed. +C +C -- QJDP is the major-tick-mark dash pattern (0. .LE. QJDP .LE. 65535.) +C QJDP .LE. 0 suppresses major ticks. +C +C -- WMJL and WMJR are the distances to the left and right ends of the +C major tick marks, stated as fractions of the shortest side of the +C curve window. Values .EQ. 0 may be used to suppress one or both +C portions. Values .GE. 1 may be used to extend a given portion all +C the way to the edge of the curve window. (See routine AGCTKO.) +C +C -- NMNT is the number of minor tick marks to be placed between each +C pair of consecutive major tick marks. NMNT .EQ. 0 suppresses them. +C +C -- QNDP, WMNL, and WMNR are analogous to QJDP, WMJL, and WMJR, but +C specify minor-tick-mark characteristics. +C +C -- NLTP, NLEX, and NLFL specify the graphic form of numeric labels, as +C described in the routine AGNUMB (which see). Note that NLTP .LE. 0 +C suppresses numeric labels. +C +C -- NLOF and NLOS are first and second choices for the numeric label +C orientation. Both must be multiples of 90, specifying an angle +C measured in degrees counter-clockwise from a vector running from +C left to right in the curve window. If ITST .EQ. 0, AGAXIS uses +C NLOF if it is .GE. 0, NLOS otherwise, for the label orientation. +C If ITST .NE. 0, AGAXIS initially makes both NLOF and NLOS positive. +C Then, if ITST .GE. 3, NLOF may or may not be made negative. (To +C set the sign of NLOF or NLOS, AGAXIS adds or subtracts 360*K.) +C +C -- DNLA is the desired distance of numeric labels from the axis, +C positive to the left, negative to the right, of the axis. The +C magnitude of DNLA is the size of the gap between the axis and the +C nearest edge of a label, expressed as a fraction of the smaller +C dimension of the curve window. See also RFNL, below. +C +C -- WCLM and WCLE are the desired widths of characters in the mantissa +C or the exponent, respectively, of numeric labels, expressed as a +C fraction of the smaller dimension of the curve window. See also +C RFNL, below. +C +C -- RFNL is a reduction factor, used as a multiplier for DNLA, WCLM, +C and WCLE. If ITST .NE. 0, RFNL is initially set to 1. - then, if +C ITST .EQ. 2 or 4, it is reset as necessary to shrink the labels. +C +C -- MCIM and MCIE specify the maximum number of characters in the +C mantissa and exponent, respectively, of a numeric label. These +C are input parameters if ITST .EQ. 0, output parameters otherwise. +C +C -- WNLL, WNLR, WNLB, and WNLE are the widths of numeric-label strips +C on the left side, on the right side, at the beginning, and at the +C end, of the axis. These are both input and output parameters of +C AGAXIS. On input, they specify the amount of space available for +C numeric labels - on output, they specify the amount of space used +C (if ITST .EQ. 0) or required (if ITST .NE. 0). Each is stated as +C a fraction of either the width or the height of the curve window, +C depending on the orientation of the axis in the curve window. +C +C The following common block contains other AUTOGRAPH variables, both +C real and integer, which are not control parameters. The only ones +C actually used here are ISLD, MWCM, MWCE, and MDLA. ISLD is a solid- +C line dash pattern (sixteen one bits). MWCM, MWCE, and MDLA specify +C the minimum allowed values of the width of a character in a label +C mantissa, the width of a character in a label exponent, and the +C distance of a label from the axis. All are in plotter coordinate +C units. +C + COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ , + + INIF +C +C The AUTOGRAPH function AGFPBN is of type integer. +C + INTEGER AGFPBN +C +C Local data required are as follows: +C +C BFRM is a buffer in which the routine AGNUMB returns the characters of +C a label mantissa. CTMP holds a sub-string from an AGPWRT call. +C + CHARACTER*40 BFRM + CHARACTER*40 CTMP +C +C BFRE is a buffer in which the routine AGNUMB returns the characters of +C a label exponent. +C + CHARACTER*5 BFRE +C +C XMJT, YMJT, XMNT, and YMNT are used to hold x and y offsets to the +C endpoints of left-of-label and right-of-label portions of major and +C minor tick marks. +C + DIMENSION XMJT(4),YMJT(4),XMNT(4),YMNT(4) +C +C SMJP is the minimum distance allowed between major tick marks, in +C plotter coordinate units. +C + DATA SMJP / 4. / +C +C FBGM, FBGP, FNDM, and FNDP are the coordinates of points a little on +C either side of the beginning and end of the axis, as fractions of the +C distance along the axis. +C + DATA FBGM / -0.000001 / + DATA FBGP / +0.000001 / + DATA FNDM / +0.999999 / + DATA FNDP / +1.000001 / +C +C HCFW is an arithmetic statement function specifying the height of a +C character as a function of its width (not counting "white space"). +C The value of the multiplier was determined heuristically, by trying +C various values and seeing which gave the best results. +C + HCFW(WDTH)=1.25*WDTH +C +C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* +C +C This is the initialization section of AGAXIS. +C +C Unpack integer values from floating-point arguments. +C + ITST=IFIX(QTST) + ISPA=IFIX(QSPA) + LLUA=IFIX(QLUA) + NBTP=IFIX(QBTP) + NMNT=IFIX(QMNT) + NLTP=IFIX(QLTP) + NLEX=IFIX(QLEX) + NLFL=IFIX(QLFL) + NLOF=IFIX(QLOF) + NLOS=IFIX(QLOS) + MCIM=IFIX(QCIM) + MCIE=IFIX(QCIE) +C +C Initialize the local flags which specify what entities to draw, using +C values appropriate for the following quick exit. +C + LDAX=1-ISPA + LDNL=0 + LDMN=0 +C +C If AGAXIS is to draw only the axis, exit immediately. +C + IF (ITST.LT.0) GO TO 800 +C +C If either NBTP or BASE is zeroed, exit immediately. +C + IF (NBTP.EQ.0.OR.BASE.EQ.0.) GO TO 800 +C +C Re-initialize the flag controlling the drawing of numeric labels. +C + IF (NLTP.NE.0) LDNL=1 +C +C If this is not a test run, skip. +C + IF (ITST.EQ.0) GO TO 101 +C +C This is a test run - exit if there are no numeric labels. +C + IF (LDNL.EQ.0) GO TO 800 +C +C This is a test run and the axis is to have numeric labels - initialize +C the numeric-label orientation and sizing parameters. Clobber drawing. +C + NLOF=MOD(NLOF+3600,360) + NLOS=MOD(NLOS+3600,360) + RFNL=1. + MCIM=0 + MCIE=0 + LDMJ=0 + LDMN=0 +C +C The main body of the initialization follows. +C +C Compute the length of the smaller side of the curve window, in the +C plotter coordinate system. +C + 101 SCWP=AMIN1(WCWP,HCWP) +C +C Compute a set of direction numbers for the axis, in the curve-window +C coordinate system (the change in x and y from the beginning to the +C end of the axis). +C + XDNA=XNDA-XBGA + YDNA=YNDA-YBGA +C +C Compute the length of the axis in the plotter coordinate system and +C its direction cosines. +C + XDNP=XDNA*WCWP + YDNP=YDNA*HCWP + AXLP=SQRT(XDNP*XDNP+YDNP*YDNP) + XDCA=XDNP/AXLP + YDCA=YDNP/AXLP +C +C Compute the axis orientation angle, in degrees counter-clockwise. +C + IAOR=MOD(IFIX(57.2957795130823*ATAN2(YDCA,XDCA)+3600.5),360) +C +C Compute the multiplicative constants required to convert a fraction of +C the axis length to a fraction of the width or height of the curve +C window (a distance in x or y). +C + CFAX=AXLP/WCWP + CFAY=AXLP/HCWP +C +C Compute the multiplicative constants required to convert a fraction of +C the axis length to a fraction of the along-axis and perpendicular-to- +C axis sides of the curve window. +C + CFAA=ABS(XDCA*CFAX+YDCA*CFAY) + CFAP=ABS(XDCA*CFAY+YDCA*CFAX) +C +C Compute the quantities (UBEG) and (UDIF) for AGFTOL. +C + IF (LLUA.NE.0) GO TO 102 +C + UBEG=UBGA + UDIF=UNDA-UBGA + GO TO 103 +C + 102 UBEG=ALOG10(UBGA) + UDIF=ALOG10(UNDA)-UBEG +C +C SMJT and SMNT are fractions of the axis length and specify the minimum +C space which must be available between two major ticks before the major +C ticks themselves or the minor ticks between them, respectively, may be +C drawn. +C + 103 SMJT=SMJP/AXLP + SMNT=SMJT*FLOAT(NMNT+1) +C +C Initialize the fractional numeric-label character heights. +C + FHCM=0. + FHCE=0. +C +C If the axis has no numeric labels, skip the following code. +C + IF (LDNL.EQ.0) GO TO 104 +C +C Zero the numeric-label offset. +C + FNLO=0. +C +C The numeric-label parameters are computed by an internal procedure +C (which see, below). +C + ASSIGN 104 TO JMP3 + GO TO 500 +C +C If this is a test run, skip the following code. +C + 104 IF (ITST.NE.0) GO TO 200 +C +C This is not a test run. First, set up the tick-mark parameters. +C +C Compute the multiplicative constant required to convert a fraction of +C the smaller dimension of the grid to a fraction of the axis length. +C + CSFA=SCWP/AXLP +C +C Compute the widths of the left and right portions of the numeric-label +C space as fractions of the axis length, affixing an appropriate sign. +C + FNLL=-WNLL/CFAP + FNLR=+WNLR/CFAP +C +C Compute a jump parameter to sort out the axis orientations. +C + JAOR=1+IAOR/90 +C +C The routine AGCTKO is used to compute the rest of the tick parameters. +C + CALL AGCTKO (XBGA,YBGA,XDCA,YDCA,CFAX,CFAY,CSFA,JAOR, 1,QJDP, + + WMJL,WMJR,FNLL,FNLR,MJ12,MJ34,XMJT,YMJT) +C + CALL AGCTKO (XBGA,YBGA,XDCA,YDCA,CFAX,CFAY,CSFA,JAOR,NMNT,QNDP, + + WMNL,WMNR,FNLL,FNLR,MN12,MN34,XMNT,YMNT) +C +C Set the flags controlling the drawing of tick marks. +C + LDMJ=MJ12+MJ34 + LDMN=MN12+MN34 + LDLR=-(LDMJ+LDMN) +C +C If no numeric labels are to be drawn, skip the following code. +C + IF (LDNL.EQ.0) GO TO 117 +C +C Numeric labels are to be drawn. Precompute parameters which will be +C used to position labels relative to the axis. +C +C Compute the widths and heights of the longest possible label mantissa +C and exponent, as fractions of the length of the axis. +C + FWLM=FLOAT(MCIM)*FWCM + FWLE=FLOAT(MCIE)*FWCE + FHLM=FHCM + FHLE=FHCE + IF (MCIE.EQ.0) FHLE=0. +C +C Jump on the label-to-axis orientation. +C + GO TO (105,106,107,108) , JLAO +C +C Label is at a 0-degree angle to the axis. +C + 105 FBLP=-FHLM + GO TO 109 +C +C Label is at a 90-degree angle to the axis. +C + 106 FBLA=0. + FBLQ=-FWLM-FWLE + GO TO 110 +C +C Label is at a 180-degree angle to the axis. +C + 107 FBLP=FHLM+FHLE + GO TO 109 +C +C Label is at a 270-degree angle to the axis. +C + 108 FBLA=0. + FBLQ=FWLM+FWLE + GO TO 110 +C +C Label is parallel to the axis. +C + 109 FNLW=FHLM+.5*FHLE + FBLQ=0. + GO TO 111 +C +C Label is perpendicular to the axis. +C + 110 FNLW=FWLM+FWLE + FBLP=0. +C +C If the labels will not fit in the space provided, clobber them. +C + 111 IF (.999999*FNLW.LT.FNLR-FNLL) GO TO 112 +C + LDNL=0 + GO TO 117 +C +C Jump on the signed value of the numeric-label distance from the axis. +C + 112 IF (DNLA) 113,114,115 +C +C Labels are to the right of the axis. +C + 113 FNLC=FDLA+.5*FNLW + FBLP=FDLA+.5*ABS(FBLP-FHLE) + FBLQ=FDLA+.5*ABS(FBLQ+FWLM-FWLE) + GO TO 116 +C +C Labels are centered on the axis. +C + 114 FNLC=0. + FBLP=0. + FBLQ=0. + GO TO 116 +C +C Labels are to the left of the axis. +C + 115 FNLC=-(FDLA+.5*FNLW) + FBLP=-(FDLA+.5*ABS(FBLP)) + FBLQ=-(FDLA+.5*ABS(FBLQ-FWLM+FWLE)) +C + 116 FNLO=.5*(FNLL+FNLR)-FNLC +C +C If the axis would pass through the offset labels, clobber it. +C + IF (FNLL*FNLR.LT.0.) LDAX=0 +C +C Jump to draw numeric labels and/or tick marks. +C + GO TO 200 +C +C No numeric labels are to be drawn. If no tick marks are to be drawn +C either, exit. +C + 117 IF (LDLR.EQ.0) GO TO 800 +C +C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* +C +C The following code directs the process of tick-marking and labelling +C the axis, using the internal procedures which follow it. If the +C label-coordinate-system value 0 maps onto the axis, tick-marking and +C labelling are done in two passes, one starting at 0 and proceeding +C in a positive direction and the other starting at 0 and proceeding +C in a negative direction. If the label-coordinate-system value 0 does +C not map onto the axis, only one pass is required. +C +C First, determine the label-coordinate-system values VBGM and VNDP at +C the points FBGM and FNDP, a little beyond the ends of the axis. +C + 200 CALL AGFTOL (IAXS,1,FBGM,VBGM,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,BASE) + CALL AGFTOL (IAXS,1,FNDP,VNDP,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,BASE) +C +C If zero falls on the axis, jump to the two-pass section of the code. +C + IF (VBGM*VNDP.LE.0.) GO TO 201 +C +C We may tick-mark and label the axis in a single pass. Compute an +C appropriate starting value for the exponent/multiplier EXMU. +C + SBSE=SIGN(BASE,VBGM) + CALL AGFTOL (IAXS,2,FBGM,EBGM,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,SBSE) + CALL AGFTOL (IAXS,2,FNDP,ENDP,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,SBSE) + EXMU=AMIN1(EBGM,ENDP) + EXMU=EXMU-AMOD(EXMU,1.)+.5+SIGN(.5,EXMU) +C +C Set the numeric-label-space limits for the beginning and end of the +C axis. +C + FNLB=FBGM-WNLB/CFAA-.5*(FHCM+FHCE) + FNLE=FNDP+WNLE/CFAA+.5*(FHCM+FHCE) +C +C Jump to an internal procedure to tick-mark and label the axis. Return +C from there to the termination section of AGAXIS. +C + ASSIGN 800 TO JMP1 + GO TO 300 +C +C Tick marks and labels must be done in two passes. First, draw the +C tick mark and/or label at the zero position in the label system, using +C an internal procedure below. A number of parameters must be preset. +C + 201 CALL AGFTOL (IAXS,-1,0.,FRAX,VLCS,LLUA,UBEG,UDIF,FUNS,NBTP,BASE) +C +C Determine whether label is to be drawn or not. +C + LDLB=0 + IF (LDNL.EQ.0) GO TO 202 + LDLB=1 +C +C The mantissa portion of the label consists of the single character 0. +C + BFRM(1:1)='0' + NCIM=1 + IPXM=0 +C +C The label has no exponent portion. +C + NCIE=0 +C +C Allow the user to change the numeric label. +C + CALL AGCHNL (IAXS,VLCS,BFRM,40,NCIM,IPXM,BFRE,5,NCIE) +C +C Compute the length of the mantissa, the exponent, and the whole label. +C + FLLM=FLOAT(NCIM)*FWCM + FLLE=FLOAT(NCIE)*FWCE + FLLB=FLLM+FLLE +C +C The numeric-label space begins and ends at impossible values. +C + FNLB=-10. + FNLE=+10. +C +C Force the labeler to update FNLB, rather than FNLE. +C + FDIR=1. +C +C Jump to an internal procedure to draw the label and/or the tick mark. +C + 202 ASSIGN 203 TO JMP2 + GO TO 400 +C +C Save the position of the zero-point (FRAX, expressed as a fraction of +C the axis length) and preset the parameter DZRT, which is the minimum +C distance from the zero-point at which a major tick mark could occur, +C and the parameter DZRL, which is the minimum distance from the zero- +C point at which a label could occur. Set the label-space limit FNLE. +C Preset the internal-procedure exit parameter JMP1. +C + 203 ASSIGN 205 TO JMP1 + FZRO=FRAX + DZRT=AMAX1(SMJT,1.6*FLOAT(LDNL)*FHCM) + IF (LDNL.EQ.0) GO TO 204 + DZRL=FNLB-FZRO + FNLE=FNDP+WNLE/CFAA+.5*(FHCM+FHCE) +C +C Do the portion of the axis lying in the direction specified by DZRT. +C If it is too short, skip it entirely. +C + 204 FRAX=FZRO+DZRT + IF (FRAX.LT.FBGM.OR.FRAX.GT.FNDP) GO TO JMP1 , (205,800) +C +C Find out whether BASE must be negated for this portion. +C + CALL AGFTOL (IAXS,1,FRAX,VLCS,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,BASE) + SBSE=SIGN(BASE,VLCS) +C +C Compute a starting value of the exponent/multiplier EXMU. +C + CALL AGFTOL (IAXS,2,FRAX,EXMU,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP,SBSE) + EXMU=EXMU-AMOD(EXMU,1.)+.5+SIGN(.5,EXMU) +C +C Jump to an internal procedure to draw the tick marks and/or labels. +C + GO TO 300 +C +C Set up to do the second portion of the axis, then go do it. +C + 205 ASSIGN 800 TO JMP1 + DZRT=-DZRT + IF (LDNL.EQ.0) GO TO 204 + FNLB=FBGM-WNLB/CFAA-.5*(FHCM+FHCE) + FNLE=FZRO-DZRL + GO TO 204 +C +C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* +C +C The following is an internal procedure, exited via the assigned-go-to +C variable JMP1. Its purpose is to tick-mark and label a portion of the +C axis (perhaps the entire axis) at positions determined by consecutive +C values of the parameter EXMU. It prevents tick marks from piling up +C or passing through the label space and prevents overlapping of labels. +C Tick marks are drawn alternately from left to right or vice-versa. +C +C The caller has provided an initial value of EXMU, but we must consider +C possible minor tick marks in the interval (EXMU-1.,EXMU). +C + 300 EXMU=EXMU-1. +C +C Compute FRAX, which is the fractional distance along the axis, and +C VLCS, which is the value in the label coordinate system corresponding +C to the current value of EXMU. +C + CALL AGFTOL (IAXS,-2,EXMU,FRAX,VLCS,LLUA,UBEG,UDIF,FUNS,NBTP,SBSE) +C +C Move the current values of EXMU, FRAX, and VLCS to ELST, FLST, and +C VLST, specifying the last values of these parameters. Then increment +C EXMU by 1. and recompute FRAX and VLCS. (The loop through consecutive +C values of EXMU begins here.) +C + 301 ELST=EXMU + FLST=FRAX + VLST=VLCS +C + EXMU=EXMU+1. + CALL AGFTOL (IAXS,-2,EXMU,FRAX,VLCS,LLUA,UBEG,UDIF,FUNS,NBTP,SBSE) +C +C FDIR indicates the direction, FDST the magnitude, of step along axis. +C + FDIR=FRAX-FLST + FDST=ABS(FDIR) +C +C Draw minor tick marks, if any, in the interval (FLST,FRAX). +C + IF (LDMN.EQ.0.OR.FDST.LT.SMNT) GO TO 304 +C +C Use the dashed-line pattern for minor tick marks. +C + CALL DASHDB (AGFPBN(QNDP)) +C +C Minor tick marks are equally spaced in the label-coordinate system. +C + VINC=(VLCS-VLST)/FLOAT(NMNT+1) +C + DO 303 I=1,NMNT + VMNT=VLST+VINC*FLOAT(I) + CALL AGFTOL (IAXS,-1,VMNT,FMNT,DUMI,LLUA,UBEG,UDIF,FUNS,NBTP, + + SBSE) + IF (FMNT.LT.FBGP.OR.FMNT.GT.FNDM) GO TO 303 + XPAX=XBGA+FMNT*XDNA + YPAX=YBGA+FMNT*YDNA + LDLR=-LDLR + IF (LDLR.LT.0) GO TO 302 + CALL AGCHAX (0,IAXS,3,VMNT) + IF (MN12.NE.0) CALL LINED (XPAX+XMNT(1),YPAX+YMNT(1), + + XPAX+XMNT(2),YPAX+YMNT(2)) + IF (MN34.NE.0) CALL LINED (XPAX+XMNT(3),YPAX+YMNT(3), + + XPAX+XMNT(4),YPAX+YMNT(4)) + CALL AGCHAX (1,IAXS,3,VMNT) + GO TO 303 + 302 CALL AGCHAX (0,IAXS,3,VMNT) + IF (MN34.NE.0) CALL LINED (XPAX+XMNT(4),YPAX+YMNT(4), + + XPAX+XMNT(3),YPAX+YMNT(3)) + IF (MN12.NE.0) CALL LINED (XPAX+XMNT(2),YPAX+YMNT(2), + + XPAX+XMNT(1),YPAX+YMNT(1)) + CALL AGCHAX (1,IAXS,3,VMNT) + 303 CONTINUE +C +C If the end of the axis has been reached, return to caller. +C + 304 IF (FRAX.LT.FBGM.OR.FRAX.GT.FNDP) GO TO JMP1 , (205,800) +C +C Draw the major tick mark and/or the numeric label at FRAX. +C + IF (FDST.LT.SMJT) GO TO 301 + LDLB=0 + IF (LDNL.EQ.0) GO TO 305 + CALL AGNUMB (NBTP,SBSE,EXMU,NLTP,NLEX,NLFL,BFRM,40,NCIM,IPXM,BFRE, + + 5,NCIE) + CALL AGCHNL (IAXS,VLCS,BFRM,40,NCIM,IPXM,BFRE,5,NCIE) +C +C If this is not a test run, mantissa and exponent length are checked. +C + IF (ITST.EQ.0.AND.(NCIM.GT.MCIM.OR.NCIE.GT.MCIE)) GO TO 305 + LDLB=1 + FLLM=FLOAT(NCIM)*FWCM + FLLE=FLOAT(NCIE)*FWCE + FLLB=FLLM+FLLE +C +C Use the next internal procedure to draw the major tick and/or label. +C + 305 ASSIGN 301 TO JMP2 +C +C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* +C +C The following is an internal procedure, exited via the assigned-go-to +C variable JMP2. Its purpose is to draw the major tick mark and/or the +C numeric label at a specified point on the axis or, if ITST is .NE. 0, +C to predict the amount of space which will be required for such items. +C +C Jump if no label is to be drawn. +C + 400 IF (LDLB.EQ.0.OR.NCIM.LE.0) GO TO 410 +C +C See if the label will fit without overlapping another label. To do +C this, first compute its fractional length along the axis (FLAA). +C + GO TO (401,402,401,402) , JLAO +C +C Label is parallel to the axis. Allow for inter-label spacing. +C + 401 FLAA=FLLB+FWCM + GO TO 403 +C +C Label is perpendicular to the axis. Ignore exponent portion. +C + 402 FLAA=1.6*FHCM +C +C Compute the fractional coordinates of the endpoints of the label +C (along the axis) and see if it will fit in the available label space. +C + 403 FLBB=FRAX-.5*FLAA + FLBE=FRAX+.5*FLAA +C + IF (FLBB.GE.FNLB.AND.FLBE.LE.FNLE) GO TO 407 +C +C Label will not fit. Omit it or, if this is a test run, see if any +C remedial action is to be taken. +C + LDLB=0 + IF (ITST.EQ.0) GO TO 411 +C +C This is a test run and we have two consecutive labels which overlap. +C See what can be done about it. +C + GO TO (424,404,406,404) , ITST +C +C We are allowed to shrink the labels. See if they are minimum-size +C already. If so, the only other possibility is to re-orient them. +C + 404 IF (IWCM.LE.MWCM.AND.IWCE.LE.MWCE.AND.IDLA.LE.MDLA) GO TO 405 +C +C If not, shrink them by an amount based on the extent of the overlap, +C reset the parameters affected, and start from square one. +C + RFNL=AMIN1(.9,FDST/(FDST+AMAX1(FNLB-FLBB,FLBE-FNLE)))*RFNL + MCIM=0 + MCIE=0 + ASSIGN 200 TO JMP3 + GO TO 500 +C +C If labels have already been shrunk to minimum size, see if we can +C re-orient them. If not, at least continue with finding the maximum +C mantissa and exponent lengths. +C + 405 IF (ITST.NE.4) GO TO 424 +C +C Try re-orienting the labels. If this has already been tried, or it it +C would be pointless, skip it, but continue with finding the maximum +C mantissa and exponent lengths. +C + 406 IF (NLOF.LT.0.OR.NLOS.EQ.NLOF.OR.JLAO.EQ.2.OR.JLAO.EQ.4) GO TO 424 +C +C If re-orienting makes sense, reset the appropriate parameters and +C start from square one. +C + NLOF=NLOF-360 + RFNL=1. + MCIM=0 + MCIE=0 + ASSIGN 200 TO JMP3 + GO TO 500 +C +C Label will fit. Update the label space limits for next time. +C + 407 IF (FDIR.GE.0.) GO TO 408 + FNLE=FLBB + GO TO 409 + 408 FNLB=FLBE +C +C If this is not just a test shot, go off and draw the tick mark/label. +C + 409 IF (ITST.EQ.0) GO TO 411 +C +C If this is a test shot, update the maximum mantissa and exponent +C lengths being generated and exit from this internal procedure. +C + MCIM=MAX0(MCIM,NCIM) + MCIE=MAX0(MCIE,NCIE) + GO TO 424 +C +C No label is to be drawn. If this is a test shot, exit from this +C internal procedure without drawing the tick mark. +C + 410 IF (ITST.NE.0) GO TO 424 +C +C Compute x and y coordinates of current axis point. +C + 411 XPAX=XBGA+FRAX*XDNA + YPAX=YBGA+FRAX*YDNA +C +C Jump if no major tick-mark is to be drawn. Otherwise, set up the +C dash pattern for major tick-marks. +C + IF (LDMJ.EQ.0) GO TO 414 + CALL DASHDB (AGFPBN(QJDP)) +C +C Flip the left-to-right/right-to-left direction flag. +C + LDLR=-LDLR +C +C Draw the first portion of the tick mark. +C + IF (LDLR) 413,414,412 +C + 412 IF (MJ12.NE.0) THEN + CALL AGCHAX (0,IAXS,2,VLCS) + CALL LINED (XPAX+XMJT(1),YPAX+YMJT(1),XPAX+XMJT(2),YPAX+YMJT(2)) + CALL AGCHAX (1,IAXS,2,VLCS) + END IF + GO TO 414 +C + 413 IF (MJ34.NE.0) THEN + CALL AGCHAX (0,IAXS,2,VLCS) + CALL LINED (XPAX+XMJT(4),YPAX+YMJT(4),XPAX+XMJT(3),YPAX+YMJT(3)) + CALL AGCHAX (1,IAXS,2,VLCS) + END IF +C +C Draw the label, if any. +C + 414 IF (LDLB.EQ.0.OR.NCIM.LE.0) GO TO 421 +C +C Compute the distances from (XPAX,YPAX) to the beginning of the label - +C along the axis (FBLA) and perpendicular to the axis (FBLP). Each is a +C directed distance whose magnitude represents a fraction of the length +C of the axis. The values depend on the label/axis orientation and the +C distance of the label from the axis. In some cases, these quantities, +C or portions of them, have already been computed. +C + GO TO (415,416,417,418) , JLAO +C +C Label is at a 0-degree angle to the axis. +C + 415 FBLA=-.5*FLLB + GO TO 419 +C +C Label is at a 90-degree angle to the axis. +C + 416 FBLP=FBLQ+FLLM + IF (DNLA.EQ.0.) FBLP=.5*FLLB + GO TO 419 +C +C Label is at a 180-degree angle to the axis. +C + 417 FBLA=.5*FLLB + GO TO 419 +C +C Label is at a 270-degree angle to the axis. +C + 418 FBLP=FBLQ-FLLM + IF (DNLA.EQ.0.) FBLP=-.5*FLLB +C +C Draw the mantissa portion of the label (excluding the "X", if any). +C + 419 DEEX=FBLA*XDCA+(FBLP+FNLO)*YDCA + DEEY=FBLA*YDCA-(FBLP+FNLO)*XDCA + CALL AGCHAX (0,IAXS,4,VLCS) + IF (IPXM.EQ.0) THEN + CALL AGPWRT (XPAX+CFAX*DEEX, + + YPAX+CFAY*DEEY,BFRM,NCIM,IWCM,NLOR,-1) + ELSE + CALL AGPWRT (XPAX+CFAX*(DEEX+(FLLM-3.*FWCM)*XDCL), + + YPAX+CFAY*(DEEY+(FLLM-3.*FWCM)*YDCL), + + BFRM,IPXM-1,IWCM,NLOR,+1) + CTMP=BFRM(IPXM+1:NCIM) + CALL AGPWRT (XPAX+CFAX*(DEEX+(FLLM-2.*FWCM)*XDCL), + + YPAX+CFAY*(DEEY+(FLLM-2.*FWCM)*YDCL), + + CTMP,NCIM-IPXM,IWCM,NLOR,-1) + END IF + DEEX=DEEX+FLLM*XDCL + DEEY=DEEY+FLLM*YDCL +C +C Draw the "X" portion of the mantissa, if it was left out above. +C + IF (IPXM.EQ.0) GO TO 420 + DEEX=DEEX-2.5*FWCM*XDCL + DEEY=DEEY-2.5*FWCM*YDCL + CALL LINE (XPAX+CFAX*(DEEX-.3*FWCM*(XDCL-YDCL)), + + YPAX+CFAY*(DEEY-.3*FWCM*(YDCL+XDCL)), + + XPAX+CFAX*(DEEX+.3*FWCM*(XDCL-YDCL)), + + YPAX+CFAY*(DEEY+.3*FWCM*(YDCL+XDCL))) + CALL LINE (XPAX+CFAX*(DEEX-.3*FWCM*(XDCL+YDCL)), + + YPAX+CFAY*(DEEY-.3*FWCM*(YDCL-XDCL)), + + XPAX+CFAX*(DEEX+.3*FWCM*(XDCL+YDCL)), + + YPAX+CFAY*(DEEY+.3*FWCM*(YDCL-XDCL))) + DEEX=DEEX+2.5*FWCM*XDCL + DEEY=DEEY+2.5*FWCM*YDCL + 420 CALL AGCHAX (1,IAXS,4,VLCS) +C +C Draw the exponent portion of the label (if it has one). +C + IF (NCIE.EQ.0) GO TO 421 + DEEX=DEEX-.5*FHCM*YDCL + DEEY=DEEY+.5*FHCM*XDCL + CALL AGCHAX (0,IAXS,5,VLCS) + CALL AGPWRT (XPAX+CFAX*DEEX,YPAX+CFAY*DEEY,BFRE,NCIE,IWCE,NLOR,-1) + CALL AGCHAX (1,IAXS,5,VLCS) +C +C Draw the second portion of the tick mark, if any. +C + 421 IF (LDLR) 423,424,422 +C + 422 IF (MJ34.NE.0) THEN + CALL AGCHAX (0,IAXS,2,VLCS) + CALL LINED (XPAX+XMJT(3),YPAX+YMJT(3),XPAX+XMJT(4),YPAX+YMJT(4)) + CALL AGCHAX (1,IAXS,2,VLCS) + END IF + GO TO 424 +C + 423 IF (MJ12.NE.0) THEN + CALL AGCHAX (0,IAXS,2,VLCS) + CALL LINED (XPAX+XMJT(2),YPAX+YMJT(2),XPAX+XMJT(1),YPAX+YMJT(1)) + CALL AGCHAX (1,IAXS,2,VLCS) + END IF +C +C Exit from internal procedure. +C + 424 GO TO JMP2 , (203,301) +C +C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* +C +C The following is an internal procedure, exited via the assigned-go-to +C variable JMP3. Its purpose is to compute all numeric-label parameters +C required by AGAXIS. +C +C Compute the desired label orientation and its direction cosines. +C + 500 NLOR=NLOF + IF (NLOR.LT.0) NLOR=NLOS +C + XDCL=COS(.017453292519943*FLOAT(NLOR)) + YDCL=SIN(.017453292519943*FLOAT(NLOR)) +C +C Compute JLAO, which is a computed-go-to jump parameter specifying the +C label-to-axis orientation. +C + JLAO=1+MOD(NLOR-IAOR+3600,360)/90 +C +C Compute the width of a character in the label mantissa, the width of a +C character in the label exponent, and the distance of a label from the +C axis, in the plotter coordinate system. +C + IWCM=MAX0(MWCM,IFIX(RFNL*ABS(WCLM)*SCWP+.5)) + IWCE=MAX0(MWCE,IFIX(RFNL*ABS(WCLE)*SCWP+.5)) + IDLA=MAX0(MDLA,IFIX(RFNL*ABS(DNLA)*SCWP+.5)) +C +C Compute the same quantities as fractions of the axis length. +C + FWCM=FLOAT(IWCM)/AXLP + FWCE=FLOAT(IWCE)/AXLP + FDLA=FLOAT(IDLA)/AXLP +C +C Compute character heights as fractions of the axis length. +C + FHCM=HCFW(FWCM) + FHCE=HCFW(FWCE) +C +C Return to internal-procedure caller. +C + GO TO JMP3 , (104,200,801) +C +C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* +C +C This is the termination section of AGAXIS. +C +C Update the parameters WNLL and WNLR to reflect the amount of space +C used/needed for numeric labels to the left and right of the axis. +C + 800 IF (LDNL.NE.0) GO TO 801 +C +C No numeric labels occur on the axis. Zero WNLL and WNLR and jump. +C + WNLL=0. + WNLR=0. + GO TO 815 +C +C Numeric labels do occur on the axis. Compute the space required. +C + 801 GO TO (802,803,802,803) , JLAO +C +C Labels are parallel to the axis. +C + 802 FNLW=FHCM + IF (MCIE.NE.0) FNLW=FNLW+.5*FHCE + GO TO 804 +C +C Labels are perpendicular to the axis. +C + 803 FNLW=FLOAT(MCIM)*FWCM+FLOAT(MCIE)*FWCE +C +C Jump on the numeric-label-distance-from-axis parameter DNLA. +C + 804 IF (DNLA) 805,806,807 +C +C Labels are to the right of the axis. +C + 805 FNLL=-FDLA + FNLR=+FDLA+FNLW + GO TO 808 +C +C Labels are centered on the axis. +C + 806 FNLL=+.5*FNLW + FNLR=+.5*FNLW + GO TO 808 +C +C Labels are to the left of the axis. +C + 807 FNLL=+FDLA+FNLW + FNLR=-FDLA +C +C Adjust FNLL and FNLR as implied by the numeric-label offset. +C + 808 FNLL=FNLL-FNLO + FNLR=FNLR+FNLO +C +C If this is not a test run, jump to reset WNLL and WNLR. +C + IF (ITST.EQ.0) GO TO 814 +C +C If this is a test run, see if the labels will fit. Jump if so. +C + IF (CFAP*FNLL.LE.WNLL.AND.CFAP*FNLR.LE.WNLR) GO TO 814 +C +C If the labels will not fit, we have a problem. We may or may not be +C able to do anything about it, depending on ITST. +C + GO TO (814,809,813,809) , ITST +C +C We are allowed to shrink the labels. See if they are minimum-size +C already. If so, the only other possibility is to re-orient them. +C + 809 IF (IWCM.LE.MWCM.AND.IWCE.LE.MWCE.AND.IDLA.LE.MDLA) GO TO 812 +C +C If not, shrink them by an amount based on the extent of the problem, +C reset the parameters affected and see if the problem is solved. +C + IF (WNLR+WNLL.GT.0.) GO TO 810 +C + RFNL=.000001*RFNL + GO TO 811 +C + 810 RFNL=AMIN1(.9,(WNLL+WNLR)/(CFAP*(FNLL+FNLR)))*RFNL +C + 811 ASSIGN 801 TO JMP3 + GO TO 500 +C +C If labels have already been shrunk to minimum size, see if we can +C re-orient them. If not, give up. +C + 812 IF (ITST.NE.3) GO TO 814 +C +C Try re-orienting the labels. If this has already been tried, or if it +C would be pointless, give up. +C + 813 IF (NLOF.LT.0.OR.NLOS.EQ.NLOF.OR.JLAO.EQ.1.OR.JLAO.EQ.3) GO TO 814 +C +C If re-orienting makes sense, reset the parameters affected and see if +C the problem is solved. +C + NLOF=NLOF-360 + RFNL=1. + ASSIGN 801 TO JMP3 + GO TO 500 +C +C Reset WNLL and WNLR for caller. +C + 814 WNLL=FNLL*CFAP + WNLR=FNLR*CFAP +C +C If this is a test run, we are now done. +C + 815 IF (ITST.GT.0) GO TO 816 +C +C Draw the axis, if it is to be drawn. +C + IF (LDAX.EQ.0) GO TO 816 +C + CALL DASHDB (ISLD) + CALL AGCHAX (0,IAXS,1,0.) + CALL LINED (XBGA,YBGA,XNDA,YNDA) + CALL AGCHAX (1,IAXS,1,0.) +C +C Pack up integer values which might have been changed into the +C corresponding floating-point arguments. +C + 816 QLOF=FLOAT(NLOF) + QLOS=FLOAT(NLOS) + QCIM=FLOAT(MCIM) + QCIE=FLOAT(MCIE) +C +C Done. +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agback.f b/sys/gio/ncarutil/autograph/agback.f new file mode 100644 index 00000000..108d2b66 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agback.f @@ -0,0 +1,152 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGBACK +C +C The subroutine AGBACK is used to draw a graph background, as directed +C by the current contents of the parameter list. +C +C The following common block contains the AUTOGRAPH control parameters, +C all of which are real. If it is changed, all of AUTOGRAPH (especially +C the routine AGSCAN) must be examined for possible side effects. +C + COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) , + + XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD , + + XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH , + + YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH , + + QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4), + + BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4), + + QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4), + + QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) , + + QODP,QCDP,WOCD,WODQ,QDSH(26) , + + QDLB,QBIM,FLLB(10,8),QBAN , + + QLLN,TCLN,QNIM,FLLN(6,16),QNAN , + + XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW , + + XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP , + + XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4), + + QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4), + + QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4), + + WNLE(4),QLUA(4) , + + RBOX(6),DBOX(6,4),SBOX(6,4) +C +C The following common block contains other AUTOGRAPH variables, both +C real and integer, which are not control parameters. +C + COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ , + + INIF +C +C Declare the block data routine external to force it to load. +C +C +NOAO - Block data replaced with run time initialization subroutine. +C +C EXTERNAL AGDFLT + call agdflt +C +C -NOAO +C +C Do an appropriate SET call for the following routines. The call is +C equivalent to "CALL SET (XLCW,XRCW,YBCW,YTCW,0.,1.,0.,1.,1)", but +C makes the viewport cover the whole plotter frame, which avoids the +C problems resulting from clipping by GKS. +C + CALL SET (0.,1.,0.,1.,-XLCW/(XRCW-XLCW),(1.-XLCW)/(XRCW-XLCW), + + -YBCW/(YTCW-YBCW),(1.-YBCW)/(YTCW-YBCW),1) +C +C Draw the labels, if any, first. +C + IDLB=IFIX(QDLB) + IF (IDLB.EQ.0) GO TO 101 +C + LBIM=IFIX(QBIM) + CALL AGLBLS (IDLB,WCWP,HCWP,FLLB,LBIM,FLLN,DBOX,SBOX,RBOX) +C +C Now draw each of the four axes. +C + 101 I=0 +C + 102 I=I+1 +C + IF (I.EQ.5) GO TO 108 +C + IF (QDAX(I).EQ.0.) GO TO 102 +C + GO TO (103,104,105,106) , I +C +C Y axis - left. +C + 103 WNLB(1)=0.-YBGW + IF (XBGA(1)-WNLL(1).LT.DBOX(3,2).AND. + + XBGA(1)+WNLR(1).GT.DBOX(3,1)) WNLB(1)=0.-DBOX(3,4) +C + WNLE(1)=YTGW-1. + IF (XBGA(1)-WNLL(1).LT.DBOX(4,2).AND. + + XBGA(1)+WNLR(1).GT.DBOX(4,1)) WNLE(1)=DBOX(4,3)-1. +C + GO TO 107 +C +C Y axis - right. +C + 104 WNLB(2)=YTGW-1. + IF (XBGA(2)-WNLR(2).LT.DBOX(4,2).AND. + + XBGA(2)+WNLL(2).GT.DBOX(4,1)) WNLB(2)=DBOX(4,3)-1. +C + WNLE(2)=0.-YBGW + IF (XBGA(2)-WNLR(2).LT.DBOX(3,2).AND. + + XBGA(2)+WNLL(2).GT.DBOX(3,1)) WNLE(2)=0.-DBOX(3,4) +C + GO TO 107 +C +C X axis - bottom. +C + 105 WNLB(3)=XRGW-1. + IF (YBGA(3)-WNLL(3).LT.DBOX(2,4).AND. + + YBGA(3)+WNLR(3).GT.DBOX(2,3)) WNLB(3)=DBOX(2,1)-1. +C + WNLE(3)=0.-XLGW + IF (YBGA(3)-WNLL(3).LT.DBOX(1,4).AND. + + YBGA(3)+WNLR(3).GT.DBOX(1,3)) WNLE(3)=0.-DBOX(1,2) +C + GO TO 107 +C +C X axis - top. +C + 106 WNLB(4)=0.-XLGW + IF (YBGA(4)-WNLR(4).LT.DBOX(1,4).AND. + + YBGA(4)+WNLL(4).GT.DBOX(1,3)) WNLB(4)=0.-DBOX(1,2) +C + WNLE(4)=XRGW-1. + IF (YBGA(4)-WNLR(4).LT.DBOX(2,4).AND. + + YBGA(4)+WNLL(4).GT.DBOX(2,3)) WNLE(4)=DBOX(2,1)-1. +C + 107 Q=AMIN1(0.,QDAX(I)) +C + CALL AGAXIS (I,Q, + + QSPA(I),WCWP,HCWP,XBGA(I),YBGA(I),XNDA(I),YNDA(I), + + QLUA(I),UBGA(I),UNDA(I),FUNS(I),QBTP(I),BASE(I), + + QJDP(I),WMJL(I),WMJR(I),QMNT(I),QNDP(I),WMNL(I), + + WMNR(I),QLTP(I),QLEX(I),QLFL(I),QLOF(I),QLOS(I), + + DNLA(I),WCLM(I),WCLE(I),RFNL(I),QCIM(I),QCIE(I), + + WNLL(I),WNLR(I),WNLB(I),WNLE(I)) +C + GO TO 102 +C +C Do set call for user and return. +C + 108 CALL SET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW, + + 1+IABS(IFIX(QLUX))*2+IABS(IFIX(QLUY))) +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agbnch.f b/sys/gio/ncarutil/autograph/agbnch.f new file mode 100644 index 00000000..4aee636a --- /dev/null +++ b/sys/gio/ncarutil/autograph/agbnch.f @@ -0,0 +1,35 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + CHARACTER*16 FUNCTION AGBNCH (IDSH) +C +C The value of this function is the character-dash-pattern equivalent of +C the integer dash pattern IDSH, a string of quotes and/or dollar signs. +C Note that the support routines IAND and ISHIFT are used. +C + KDSH=IDSH +C + DO 101 I=16,1,-1 + IF (IAND(KDSH,1).EQ.0) THEN + AGBNCH(I:I)='''' + ELSE + AGBNCH(I:I)='$' + END IF + KDSH=ISHIFT(KDSH,-1) + 101 CONTINUE +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agchax.f b/sys/gio/ncarutil/autograph/agchax.f new file mode 100644 index 00000000..451bce5c --- /dev/null +++ b/sys/gio/ncarutil/autograph/agchax.f @@ -0,0 +1,41 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGCHAX (IFLG,IAXS,IPRT,VILS) +C +C The routine AGCHAX is called by AGAXIS just before and just after each +C of a selected set of objects on the axes are drawn. A user may supply +C a version to change the appearance of these objects. The arguments +C are as follows: +C +C - IFLG is zero if a particular object is about to be drawn, non-zero +C if it has just been drawn. +C +C - IAXS is the number of the axis in question. The values 1, 2, 3, and +C 4 imply the right, left, bottom, and top axes, respectively. +C +C - IPRT is an integer implying which part of the axis is being drawn. +C The value 1 implies the line itself, 2 a major tick, 3 a minor tick, +C 4 the mantissa of a label, and 5 the exponent of a label. +C +C - VILS is the value, in the label coordinate system along the axis, +C associated with the position of the object being drawn. IPRT=1 +C implies VILS=0. +C +C Done. +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agchcu.f b/sys/gio/ncarutil/autograph/agchcu.f new file mode 100644 index 00000000..1364ad28 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agchcu.f @@ -0,0 +1,44 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGCHCU (IFLG,KDSH) +C +C The routine AGCHCU is called by AGCURV just before and just after each +C curve is drawn. The default version does nothing. A user may supply +C a version to change the appearance of the curves. The arguments are +C as follows: +C +C - IFLG is zero if a curve is about to be drawn, non-zero if a curve +C has just been drawn. +C +C - KDSH is the last argument of AGCURV, as follows: +C +C AGCURV called by Value of KDSH +C ---------------- ---------------------------------------- +C EZY 1 +C EZXY 1 +C EZMY "n" or "-n", where n is the curve number +C EZMXY "n" or "-n", where n is the curve number +C the user program the user value +C +C The sign of KDSH, when AGCURV is called by EZMY or EZMXY, indicates +C whether the "user" dash patterns or the "alphabetic" dash patterns +C were selected for use. +C +C Done. +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agchil.f b/sys/gio/ncarutil/autograph/agchil.f new file mode 100644 index 00000000..1952cf68 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agchil.f @@ -0,0 +1,36 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGCHIL (IFLG,LBNM,LNNO) +C + CHARACTER*(*) LBNM +C +C The routine AGCHIL is called by AGLBLS just before and just after each +C informational-label line of text is drawn. The default version does +C nothing. A user may supply a version to change the appearance of the +C text lines. The arguments are as follows: +C +C - IFLG is zero if a text line is about to be drawn, non-zero if one +C has just been drawn. +C +C - LBNM is the name of the label containing the line in question. +C +C - LNNO is the number of the line. +C +C Done. +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agchnl.f b/sys/gio/ncarutil/autograph/agchnl.f new file mode 100644 index 00000000..3b42a5f6 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agchnl.f @@ -0,0 +1,65 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGCHNL (IAXS,VILS,CHRM,MCIM,NCIM,IPXM,CHRE,MCIE,NCIE) +C + CHARACTER*(*) CHRM,CHRE +C +C The routine AGCHNL is called by AGAXIS just after it has set up the +C character strings comprising a numeric label along an axis. The +C default version does nothing. A user may supply his own version to +C change the numeric labels. For each numeric label, this routine is +C called twice by AGAXIS - once to determine how much space will be +C required when the label is actually drawn and once just before it +C is actually drawn. The arguments are as follows: +C +C - IAXS is the number of the axis being drawn. Its value is 1, 2, 3, +C or 4, implying the left, right, bottom, or top axes, respectively. +C The value of IAXS must not be altered. +C +C - VILS is the value to be represented by the numeric label, in the +C label system for the axis. The value of VILS must not be altered. +C +C - CHRM, on entry, is a character string containing the mantissa of the +C numeric label, as it will appear if AGCHNL makes no changes. If the +C numeric label includes a "times" symbol, it will be represented by +C a blank in CHRM. (See IPXM, below.) CHRM may be modified. +C +C - MCIM is the length of CHRM - the maximum number of characters that +C it will hold. The value of MCIM must not be altered. +C +C - NCIM, on entry, is the number of meaningful characters in CHRM. If +C CHRM is changed, NCIM should be changed accordingly. +C +C - IPXM, on entry, is zero if there is no "times" symbol in CHRM; if it +C is non-zero, it is the index of the appropriate character position +C in CHRM. If AGCHNL changes the position of the "times" symbol in +C CHRM, removes it, or adds it, the value of IPXM must be changed. +C +C - CHRE, on entry, is a character string containing the exponent of the +C numeric label, as it will appear if AGCHNL makes no changes. CHRE +C may be modified. +C +C - MCIE is the length of CHRE - the maximum number of characters that +C it will hold. The value of MCIE must not be altered. +C +C - NCIE, on entry, is the number of meaningful characters in CHRE. If +C CHRE is changed, NCIE should be changed accordingly. +C +C Done. +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agctcs.f b/sys/gio/ncarutil/autograph/agctcs.f new file mode 100644 index 00000000..d9f67d5f --- /dev/null +++ b/sys/gio/ncarutil/autograph/agctcs.f @@ -0,0 +1,79 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGCTCS (TPID,ITCS) +C + CHARACTER*(*) TPID +C +C The routine AGCTCS is called by the routines AGGETC and AGSETC to +C check what type of character-string parameter is implied by the +C parameter identifier TPID and return an appropriate value of ITCS, as +C follows: +C +C -- ITCS = 0 implies that the parameter is not intrinsically of type +C character and that AGGETC/AGSETC should not have been called in +C the way that it was. +C +C -- ITCS = 1 implies a dash-pattern parameter. +C +C -- ITCS = 2 implies a label name. +C +C -- ITCS = 3 implies the line-end character. +C +C -- ITCS = 4 implies the text of some line of some label. +C +C Find out where in the parameter list the requested parameter lies. +C + CALL AGSCAN (TPID,LOPA,NIPA,IIPA) +C +C See if it's a dash pattern. +C + CALL AGSCAN ('DASH/PATT.',LODP,NIDP,IIDP) + IF (LOPA.GE.LODP.AND.LOPA.LE.LODP+NIDP-1) THEN + ITCS=1 + RETURN + END IF +C +C See if it's a label name. +C + CALL AGSCAN ('LABE/NAME.',LOLN,NILN,IILN) + IF (LOPA.EQ.LOLN) THEN + ITCS=2 + RETURN + END IF +C +C See if it's the line-end character. +C + CALL AGSCAN ('LINE/END .',LOLE,NILE,IILE) + IF (LOPA.EQ.LOLE) THEN + ITCS=3 + RETURN + END IF +C +C See if it's the text of some label line. +C + CALL AGSCAN ('LINE/BUFF/CONT.',LOLB,NILB,IILB) + IF (LOPA.GE.LOLB.AND.LOPA.LE.LOLB+NILB-1.AND. + + MOD(LOPA-LOLB,6).EQ.3) THEN + ITCS=4 + RETURN + END IF +C +C Error - type not recognizable. +C + ITCS=0 + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agctko.f b/sys/gio/ncarutil/autograph/agctko.f new file mode 100644 index 00000000..105438cc --- /dev/null +++ b/sys/gio/ncarutil/autograph/agctko.f @@ -0,0 +1,150 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGCTKO (XBGA,YBGA,XDCA,YDCA,CFAX,CFAY,CSFA,JAOR,NMMT, + + QMDP,WMML,WMMR,FNLL,FNLR,MM12,MM34,XMMT,YMMT) +C + DIMENSION XMMT(4),YMMT(4) +C +C The routine AGCTKO is used to compute the x and y offsets to the end- +C points of the left-of-label and right-of-label portions of the major +C and minor tick marks. See AGAXIS for definitions of the arguments. +C +C A note about WMML and WMMR: Each is a positive number, of the form +C (E) or (1+E), where E (=EPSILON) is .LT. 1. and is expressed as a +C fraction of the smaller side of the curve window. If the form (E) is +C used, it implies just a tick of length E; if the form (1+E) is used, +C it implies a tick long enough to reach the edge of the curve window, +C plus the length E. +C +C If the tick-mark count NMMT .EQ. 0 or the tick-mark dash pattern QMDP +C .EQ. 0 or both the left-of-axis and right-of-axis tick-mark lengths +C WMML and WMMR .EQ. 0, then no tick marks are to be drawn. +C + IF (NMMT.EQ.0.OR.QMDP.EQ.0..OR.(WMML.EQ.0..AND.WMMR.EQ.0.)) + * GO TO 115 +C +C Compute the distances of the tick mark ends from the axis as fractions +C of the axis length, using only the (EPSILON) portion of WMML and WMMR. +C + FMML=-CSFA*AMOD(WMML,1.) + FMMR=+CSFA*AMOD(WMMR,1.) +C +C If the labels overlap the axis and the (EPSILON) form was used for +C WMML or WMMR, move the tick mark to the end of the label. +C + IF (FNLL*FNLR.GE.0.) GO TO 101 +C + IF (WMML.LT.1.) FMML=FMML+FNLL +C + IF (WMMR.LT.1.) FMMR=FMMR+FNLR +C +C Compute the x and y offsets to the ends of the tick mark. +C + 101 XMML=+CFAX*FMML*YDCA + YMML=-CFAY*FMML*XDCA + XMMR=+CFAX*FMMR*YDCA + YMMR=-CFAY*FMMR*XDCA +C +C If the (1+EPSILON) form was used for WMML or WMMR, adjust XMML, YMML, +C XMMR, and YMMR as implied by the current axis orientation. +C + IF (WMML.LT.1.) GO TO 107 +C + GO TO (102,103,104,105) , JAOR +C +C Axis at 0 degrees (left to right). +C + 102 YMML=YMML+1.-YBGA + GO TO 106 +C +C Axis at 90 degrees (bottom to top). +C + 103 XMML=XMML-XBGA + GO TO 106 +C +C Axis at 180 degrees (right to left). +C + 104 YMML=YMML-YBGA + GO TO 106 +C +C Axis at 270 degrees (top to bottom). +C + 105 XMML=XMML+1.-XBGA +C + 106 FMML=(XMML+YMML)/(CFAX*YDCA-CFAY*XDCA) +C + 107 IF (WMMR.LT.1.) GO TO 113 +C + GO TO (108,109,110,111) , JAOR +C +C Axis at 0 degrees (left to right). +C + 108 YMMR=YMMR-YBGA + GO TO 112 +C +C Axis at 90 degrees (bottom to top). +C + 109 XMMR=XMMR+1.-XBGA + GO TO 112 +C +C Axis at 180 degrees (right to left). +C + 110 YMMR=YMMR+1.-YBGA + GO TO 112 +C +C Axis at 270 degrees (top to bottom). +C + 111 XMMR=XMMR-XBGA +C + 112 FMMR=(XMMR+YMMR)/(CFAX*YDCA-CFAY*XDCA) +C +C Now split the tick mark into two portions - one to the left, and one +C to the right, of the numeric label space. +C + 113 XMMT(1)=XMML + YMMT(1)=YMML + XMMT(2)=XMMR + YMMT(2)=YMMR + MM12=1 + MM34=0 + IF (FMMR.LE.FNLL.OR.FNLL.GE.FNLR) RETURN +C + MM12=0 + IF (FMML.GE.FNLL) GO TO 114 + MM12=1 + XMMT(2)=+CFAX*(FNLL-.005*CSFA)*YDCA + YMMT(2)=-CFAY*(FNLL-.005*CSFA)*XDCA +C + 114 IF (FMMR.LE.FNLR) RETURN +C + MM34=1 + XMMT(4)=XMMR + YMMT(4)=YMMR + XMMT(3)=XMML + YMMT(3)=YMML +C + IF (FMML.GE.FNLR) RETURN + XMMT(3)=+CFAX*(FNLR+.005*CSFA)*YDCA + YMMT(3)=-CFAY*(FNLR+.005*CSFA)*XDCA + RETURN +C +C No ticks to be drawn - zero the flags MM12 and MM34 to indicate this. +C + 115 MM12=0 + MM34=0 + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agcurv.f b/sys/gio/ncarutil/autograph/agcurv.f new file mode 100644 index 00000000..47624321 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agcurv.f @@ -0,0 +1,149 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGCURV (XVEC,IIEX,YVEC,IIEY,NEXY,KDSH) +C + DIMENSION XVEC(1),YVEC(1) +C +C AGCURV plots the curve defined by the points ((X(I),Y(I)),I=1,NEXY), +C where, if the primary parameter 'INVERT.' is zero, +C +C X(I)=XVEC(1+(I-1)*IIEX) (unless IIEX=0, in which case X(I)=I), and +C Y(I)=YVEC(1+(I-1)*IIEY) (unless IIEY=0, in which case Y(I)=I). +C +C If 'INVERT.' is non-zero, the definitions are interchanged, so that +C +C X(I)=YVEC(1+(I-1)*IIEY) (unless IIEY=0, in which case X(I)=I), and +C Y(I)=XVEC(1+(I-1)*IIEX) (unless IIEX=0, in which case Y(I)=I). +C +C If, for some I, X(I)=SVAL or Y(I)=SVAL, curve line segments having +C (X(I),Y(I)) as an endpoint are omitted. +C +C If the primary parameter 'WINDOW.' is zero, AGKURV is called; it does +C no windowing. If 'WINDOW.' is non-zero, AGQURV is called; it omits +C portions of the curve which fall outside the current curve window. +C +C The argument KDSH specifies the dash pattern to be used. If KDSH is +C negative, the function MOD(IABS(KDSH),26) is used to select a solid +C line interrupted by one of the alphabetic characters. If KDSH is +C zero, the user is assumed to have done his own DASHD call. If KDSH +C is positive, the function MOD(KDSH,NODP) is used to select one of the +C dash patterns in the parameter group 'DASH/PATTERNS.'. +C +C The following common block contains the AUTOGRAPH control parameters, +C all of which are real. If it is changed, all of AUTOGRAPH (especially +C the routine AGSCAN) must be examined for possible side effects. +C + COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) , + + XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD , + + XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH , + + YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH , + + QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4), + + BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4), + + QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4), + + QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) , + + QODP,QCDP,WOCD,WODQ,QDSH(26) , + + QDLB,QBIM,FLLB(10,8),QBAN , + + QLLN,TCLN,QNIM,FLLN(6,16),QNAN , + + XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW , + + XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP , + + XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4), + + QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4), + + QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4), + + WNLE(4),QLUA(4) , + + RBOX(6),DBOX(6,4),SBOX(6,4) +C +C Declare the block data routine external to force it to load. +C +C +NOAO +C EXTERNAL AGDFLT +C -NOAO +C +C DASH receives alphabetic dash patterns. +C + CHARACTER*10 DASH +C +C ALPH contains an alphabet. +C + CHARACTER*26 ALPH +C + DATA ALPH / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' / +C +C +NOAO - replace blockdata with run time initialization. + call agdflt +C -NOAO +C +C Check for an alphabetic dash pattern. +C + IF (KDSH.LT.0) THEN + IDSH=MOD(-KDSH-1,26)+1 + IPSN=MOD(3*IDSH-1,10)+1 + DASH='$$$$$$$$$$' + DASH(IPSN:IPSN)=ALPH(IDSH:IDSH) + CALL AGSTCH (DASH,10,IDCS) + CALL AGDASH (FLOAT(IDCS),WODQ,WOCD,SCWP) + CALL AGDLCH (IDCS) +C +C Check for a dash pattern from the group "DASH/PATTERNS." +C + ELSE IF (KDSH.GT.0) THEN + IDSH=MOD(KDSH-1,IFIX(QODP))+1 + CALL AGDASH (QDSH(IDSH),WODQ,WOCD,SCWP) +C + END IF +C +C Now that the dash pattern is determined, do the SET call. +C + CALL SET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW, + + 1+IABS(IFIX(QLUX))*2+IABS(IFIX(QLUY))) +C +C Give the user a chance to modify the curve (by changing line style, +C color, etc.). +C + CALL AGCHCU (0,KDSH) +C +C Decide whether AGKURV or AGQURV is to draw the curve. +C + IF (QWND.EQ.0.) THEN +C +C No windowing requested - AGKURV is used. +C + IF (QIXY.EQ.0.) THEN + CALL AGKURV (XVEC,IIEX,YVEC,IIEY,NEXY,SVAL(1)) + ELSE + CALL AGKURV (YVEC,IIEY,XVEC,IIEX,NEXY,SVAL(1)) + END IF +C + ELSE +C +C Windowing requested - AGQURV is used. +C + IF (QIXY.EQ.0.) THEN + CALL AGQURV (XVEC,IIEX,YVEC,IIEY,NEXY,SVAL(1)) + ELSE + CALL AGQURV (YVEC,IIEY,XVEC,IIEX,NEXY,SVAL(1)) + END IF +C + END IF +C +C Give the user a chance to change back what he changed above. +C + CALL AGCHCU (1,KDSH) +C +C Done. +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agdash.f b/sys/gio/ncarutil/autograph/agdash.f new file mode 100644 index 00000000..243eb808 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agdash.f @@ -0,0 +1,69 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGDASH (DASH,WODQ,WOCD,SCWP) +C +C AGDASH sets up the DASHD call required to establish the dash pattern +C desired for the next curve. The arguments are as follows: +C +C -- DASH specifies the desired dash pattern. A positive value implies +C that a binary dash pattern is to be used, a negative value that a +C character-string dash pattern is to be used. +C +C -- WODQ is the width of the solid-line segment specified by a dollar +C sign and the gap specified by a quote, expressed as a fraction of +C the smaller side of the curve window. +C +C -- WOCD is the width of a character which is to be a part of the dash +C pattern, expressed in the same units as WODQ. +C +C -- SCWP is the length of the smaller side of the curve window, in +C plotter coordinate units. +C +C The following common block contains other AUTOGRAPH variables, both +C real and integer, which are not control parameters. The only ones +C used here are MWCD and MWDQ - the minimum widths of characters and +C spaces, respectively, in the dash pattern. +C + COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ , + + INIF +C +C The following common block contains other AUTOGRAPH variables, of type +C character. +C + COMMON /AGOCHP/ CHS1,CHS2 +C +c+noao +c CHARACTER*504 CHS1,CHS2 + CHARACTER*500 CHS1,CHS2 +c-noao +C +C The AUTOGRAPH function AGFPBN is of type integer. +C + INTEGER AGFPBN +C + IWCD=MAX0(MWCD,IFIX(WOCD*SCWP)) + IWDQ=MAX0(MWDQ,IFIX(WODQ*SCWP)) +C + IF (DASH.GE.0.) THEN + CALL DASHDB (AGFPBN(DASH)) + ELSE + CALL AGGTCH (IFIX(DASH),CHS1,LNC1) + CALL DASHDC (CHS1(1:LNC1),IWDQ,IWCD) + END IF +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agdflt.bd b/sys/gio/ncarutil/autograph/agdflt.bd new file mode 100644 index 00000000..ddbde9a1 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agdflt.bd @@ -0,0 +1,414 @@ +C +NOAO +C This block data has been rewritten as a run time initialization +C subroutine (see file agdflt.f). This original block data file +C is retained for reference only. +C -NOAO +C +C --------------------------------------------------------------------- +C + BLOCK DATA AGDFLT +C +C The block data subroutine AGDFLT defines the default values of those +C AUTOGRAPH parameters which can be declared in a DATA statement. See +C AGINIT for code initializing other AUTOGRAPH parameters. +C +C Following are declarations of all the AUTOGRAPH common blocks. +C +C The following common block contains the AUTOGRAPH control parameters, +C all of which are real. If it is changed, all of AUTOGRAPH (especially +C the routine AGSCAN) must be examined for possible side effects. +C + COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) , + + XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD , + + XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH , + + YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH , + + QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4), + + BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4), + + QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4), + + QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) , + + QODP,QCDP,WOCD,WODQ,QDSH(26) , + + QDLB,QBIM,FLLB(10,8),QBAN , + + QLLN,TCLN,QNIM,FLLN(6,16),QNAN , + + XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW , + + XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP , + + XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4), + + QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4), + + QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4), + + WNLE(4),QLUA(4) , + + RBOX(6),DBOX(6,4),SBOX(6,4) +C +C The following common block contains other AUTOGRAPH variables, both +C real and integer, which are not control parameters. +C + COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ , + + INIF +C +C The following common block contains other AUTOGRAPH variables, of +C type character. +C + COMMON /AGOCHP/ CHS1,CHS2 +C + CHARACTER*504 CHS1,CHS2 +C +C The following common blocks contain variables which are required for +C the character-storage-and-retrieval scheme of AUTOGRAPH. +C + COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA +C + COMMON /AGCHR2/ CHRA(2000) +C + CHARACTER*1 CHRA +C +C --------------------------------------------------------------------- +C +C Following are declarations of default values of variables in the +C AUTOGRAPH common blocks. +C +C --------------------------------------------------------------------- +C +C QFRA defines the control parameter 'FRAME.', which specifies when, if +C ever, the EZ... routines are to call FRAME to advance to a new frame. +C + DATA QFRA / 1. / +C +C QSET defines the control parameter 'SET.', which determines how the +C last call to the plot-package routine "SET" is to affect AUTOGRAPH. +C + DATA QSET / 1. / +C +C QROW defines the control parameter 'ROW.', which determines how the x +C and y input arrays (in calls to AGSTUP and AGCURV) are to be used. +C + DATA QROW / 1. / +C +C QIXY defines the control parameter 'INVERT.', which, if set non-zero, +C causes the routines AGSTUP and AGCURV to behave as if the arguments +C defining the x and y data had been interchanged. +C + DATA QIXY / 0. / +C +C QWND defines the control parameter 'WINDOW.', which, if set non-zero, +C causes curves drawn to be scissored by the edge of the curve window. +C + DATA QWND / 0. / +C +C QBAC defines the control parameter 'BACKGROUND.', which can be given +C any of four values to set up four specific types of plot background. +C + DATA QBAC / 1. / +C +C SVAL defines the control parameters 'NULL/1.' and 'NULL/2.', which are +C used in various ways by AUTOGRAPH. +C + DATA SVAL(1) / 1E36 / , SVAL(2) / 2E36 / +C +C XLGF, XRGF, YBGF, and YTGF define the parameter-group 'GRAPH.'; they +C specify the position of the graph window within the plotter frame. +C + DATA XLGF / 0. / , XRGF / 1. / , YBGF / 0. / , YTGF / 1. / +C +C XLGD, XRGD, YBGD, and YTGD define the first four parameters in the +C group 'GRID.'; they specify the position of the grid window within +C the graph window. +C + DATA XLGD / .15 / , XRGD / .95 / , YBGD / .15 / , YTGD / .95 / +C +C SOGD defines the control parameter 'GRID/SHAPE.', which defines the +C shape of the grid window. +C + DATA SOGD / 0. / +C +C XMIN and XMAX define the control parameters 'X/MIN.' and 'X/MAX.', +C which determine how minimum and maximum values of x are to be chosen. +C Null values imply that AUTOGRAPH is to choose real values; non-null +C values are the actual values to be used (perhaps after rounding). +C + DATA XMIN / 1E36 / , XMAX / 1E36 / +C +C QLUX defines the control parameter 'X/LOG.', which is set non-zero to +C specify that the horizontal axis is to be logarithmic. +C + DATA QLUX / 0. / +C +C QOVX defines the control parameter 'X/ORDER.', which is set non-zero +C to flip the horizontal axis end-for-end. +C + DATA QOVX / 0. / +C +C QCEX defines the control parameter 'X/NICE.', which determines which, +C if either, of the horizontal axes is to have "nice" (rounded) values +C at its ends. +C + DATA QCEX / -1. / +C +C XLOW and XHGH define the control parameters 'X/SMALLEST.' and +C 'X/LARGEST.'; they come into play only when XMIN and/or XMAX are null +C and they are non-null, in which case they set limits on the range of +C x data to be considered when choosing the minimum and/or maximum. +C + DATA XLOW / 1E36 / , XHGH / 1E36 / +C +C YMIN and YMAX define the control parameters 'Y/MIN.' and 'Y/MAX.', +C which determine how minimum and maximum values of y are to be chosen. +C Null values imply that AUTOGRAPH is to choose real values; non-null +C values are the actual values to be used (perhaps after rounding). +C + DATA YMIN / 1E36 / , YMAX / 1E36 / +C +C QLUY defines the control parameter 'Y/LOG.', which is set non-zero to +C specify that the horizontal axis is to be logarithmic. +C + DATA QLUY / 0. / +C +C QOVY defines the control parameter 'Y/ORDER.', which is set non-zero +C to flip the horizontal axis end-for-end. +C + DATA QOVY / 0. / +C +C QCEY defines the control parameter 'Y/NICE.', which determines which, +C if either, of the horizontal axes is to have "nice" (rounded) values +C at its ends. +C + DATA QCEY / -1. / +C +C YLOW and YHGH define the control parameters 'Y/SMALLEST.' and +C 'Y/LARGEST.'; they come into play only when YMIN and/or YMAX are null +C and they are non-null, in which case they set limits on the range of +C y data to be considered when choosing the minimum and/or maximum. +C + DATA YLOW / 1E36 / , YHGH / 1E36 / +C +C QDAX(i) defines the control parameters 'AXIS/s/CONTROL.' (i=1 implies +C s='LEFT', i=2 implies s='RIGHT', i=3 implies s='BOTTOM', i=4 implies +C s='TOP'). Each of these specifies whether or not a given axis will +C be drawn or not and what liberties may be taken with numeric labels +C on the axis. +C + DATA QDAX(1)/ 4. / , QDAX(2)/ 4. / , QDAX(3)/ 4. / , QDAX(4)/ 4. / +C +C Each QSPA(i) defines a control parameter 'AXIS/s/LINE.', which says +C whether or not the line portion of a particular axis is to be drawn. +C + DATA QSPA(1)/ 0. / , QSPA(2)/ 0. / , QSPA(3)/ 0. / , QSPA(4)/ 0. / +C +C Each PING(i) defines a control parameter 'AXIS/s/INTERSECTION/GRID.', +C which may be used to move a particular axis to a specified position. +C + DATA PING(1)/1E36/ , PING(2)/1E36/ , PING(3)/1E36/ , PING(4)/1E36/ +C +C Each PINU(i) defines a control parameter 'AXIS/s/INTERSECTION/USER.', +C which may be used to move a particular axis to a specified position. +C + DATA PINU(1)/1E36/ , PINU(2)/1E36/ , PINU(3)/1E36/ , PINU(4)/1E36/ +C +C Each FUNS(i) defines a control parameter 'AXIS/s/FUNCTION.', which is +C used within a user-supplied version of AGUTOL to select a particular +C uset-system-to-label-system mapping for a particular axis. The +C default value selects the identity mapping. +C + DATA FUNS(1)/ 0. / , FUNS(2)/ 0. / , FUNS(3)/ 0. / , FUNS(4)/ 0. / +C +C The values of QBTD(i), BASD(i), QMJD(i), QJDP(i), WMJL(i), and WMJR(i) +C together define the control-parameter group 'AXIS/s/TICKS/MAJOR.', +C which determines the positioning and appearance of the major ticks on +C a particular axis. +C + DATA QBTD(1)/1E36/ , QBTD(2)/1E36/ , QBTD(3)/1E36/ , QBTD(4)/1E36/ + DATA BASD(1)/1E36/ , BASD(2)/1E36/ , BASD(3)/1E36/ , BASD(4)/1E36/ + DATA QMJD(1)/ 6. / , QMJD(2)/ 6. / , QMJD(3)/ 6. / , QMJD(4)/ 6. / + DATA QJDP(1)/1E36/ , QJDP(2)/1E36/ , QJDP(3)/1E36/ , QJDP(4)/1E36/ + DATA WMJL(1)/ 0. / , WMJL(2)/ 0. / , WMJL(3)/ 0. / , WMJL(4)/ 0. / + DATA WMJR(1)/.015/ , WMJR(2)/.015/ , WMJR(3)/.015/ , WMJR(4)/.015/ +C +C The values of QMND(i), QNDP(i), WMNL(i), and WMNR(i) together define +C the control-parameter group 'AXIS/s/TICKS/MINOR.', which determines +C the positioning and appearance of the major ticks on a particular +C axis. +C + DATA QMND(1)/1E36/ , QMND(2)/1E36/ , QMND(3)/1E36/ , QMND(4)/1E36/ + DATA QNDP(1)/1E36/ , QNDP(2)/1E36/ , QNDP(3)/1E36/ , QNDP(4)/1E36/ + DATA WMNL(1)/ 0. / , WMNL(2)/ 0. / , WMNL(3)/ 0. / , WMNL(4)/ 0. / + DATA WMNR(1)/.010/ , WMNR(2)/.010/ , WMNR(3)/.010/ , WMNR(4)/.010/ +C +C The values of QLTD(i), QLED(i), QLFD(i), QLOF(i), QLOS(i), DNLA(i), +C WCLM(i), and WCLE(i) together define the control-parameter group +C 'AXIS/s/NUMERIC.', which determines the positioning and appearance of +C the numeric labels on a particular axis. +C + DATA QLTD(1)/1E36/ , QLTD(2)/ 0./ , QLTD(3)/1E36/ , QLTD(4)/ 0./ + DATA QLED(1)/1E36/ , QLED(2)/1E36/ , QLED(3)/1E36/ , QLED(4)/1E36/ + DATA QLFD(1)/1E36/ , QLFD(2)/1E36/ , QLFD(3)/1E36/ , QLFD(4)/1E36/ + DATA QLOF(1)/ 0. / , QLOF(2)/ 0. / , QLOF(3)/ 0. / , QLOF(4)/ 0. / + DATA QLOS(1)/ 90./ , QLOS(2)/ 90./ , QLOS(3)/ 90./ , QLOS(4)/ 90./ + DATA DNLA(1)/.015/ , DNLA(2)/.015/ , DNLA(3)/.015/ , DNLA(4)/.015/ + DATA WCLM(1)/.015/ , WCLM(2)/.015/ , WCLM(3)/.015/ , WCLM(4)/.015/ + DATA WCLE(1)/.010/ , WCLE(2)/.010/ , WCLE(3)/.010/ , WCLE(4)/.010/ +C +C QODP defines the control parameter 'DASH/SELECTOR.', the sign of which +C determines which set of dash patterns is used by EZMY and EZMXY (the +C alphabetic set or the user-specified set); if the user-specified set +C is selected, the magnitude of QODP determines how many of them are to +C be used. +C + DATA QODP / 1. / +C +C QCDP defines the control parameter 'DASH/LENGTH.', which specifies the +C assumed length of dash patterns tendered to AUTOGRAPH. +C + DATA QCDP / 8. / +C +C WOCD and WODQ define the control parameters 'DASH/CHARACTER.' and +C 'DASH/DOLLAR-QUOTE.', which specify the widths of characters used in +C character-string dash patterns. +C + DATA WOCD / .010 / , WODQ / .010 / +C +C QDSH defines the control-parameter group 'DASH/PATTERN.'. Each value, +C if positive, defines a binary dash pattern, and, if negative, serves +C as an identifier in retrieving a character-string dash pattern. +C + DATA QDSH / 26*65535. / +C +C QDLB defines the control parameter 'LABEL/CONTROL.', which specifies +C what may be done with informational labels in response to overlap +C problems. +C + DATA QDLB /2./ +C +C QBIM defines the control parameter 'LABEL/BUFFER/LENGTH.' and must +C be equal to the second dimension of the array FLLB. +C + DATA QBIM / 8. / +C +C QBAN defines the control parameter 'LABEL/NAME.'; its value is really +C a pointer into the label list. The default value, zero, means that +C the pointer has not been set. +C + DATA QBAN / 0. / +C +C QLLN defines the control parameter 'LINE/MAXIMUM.' - the assumed +C maximum length of character strings intended for use as the text of a +C line of a label. +C + DATA QLLN /40./ +C +C TCLN defines the control parameter 'LINE/TERMINATOR.' - which is used +C to mark the end of character strings intended for use as the text of a +C line of a label. It is initialized in AGINIT. +C +C QNIM defines the control parameter 'LINE/BUFFER/LENGTH.' and must be +C equal to the second dimension of FLLN. +C + DATA QNIM / 16. / +C +C QNAN defines the control parameter 'LINE/NUMBER.'; its value is really +C a pointer into the line list. The default value, zero, says that the +C pointer has not been set. +C + DATA QNAN / 0. / +C +C (FLLB(I,1),I=1,10) and (FLLN(I,1),I=1,6) define the label to the left +C of the grid. The name, in FLLB(1,1), and the line text, in FLLN(4,1), +C must be filled in by AGINIT. +C + DATA FLLB( 1,1)/ 0./ , FLLB( 2,1)/ 0./ , FLLB( 3,1)/ 0./ , + + FLLB( 4,1)/ .5/ , FLLB( 5,1)/-.015/ , FLLB( 6,1)/ 0./ , + + FLLB( 7,1)/ 90./ , FLLB( 8,1)/ 0./ , FLLB( 9,1)/ 1./ , + + FLLB(10,1)/ 1./ , FLLN( 1,1)/+100./ , FLLN( 2,1)/ 0./ , + + FLLN( 3,1)/ .015/ , FLLN( 4,1)/ -2./ , FLLN( 5,1)/ 1./ , + + FLLN( 6,1)/ 0./ +C +C (FLLB(I,2),I=1,10) and (FLLN(I,2),I=1,6) define the label to the right +C of the grid. The name, in FLLB(1,2), and the line text, in FLLN(4,2), +C must be filled in by AGINIT. +C + DATA FLLB( 1,2)/ 0./ , FLLB( 2,2)/ 0./ , FLLB( 3,2)/ 1./ , + + FLLB( 4,2)/ .5/ , FLLB( 5,2)/+.015/ , FLLB( 6,2)/ 0./ , + + FLLB( 7,2)/ 90./ , FLLB( 8,2)/ 0./ , FLLB( 9,2)/ 1./ , + + FLLB(10,2)/ 2./ , FLLN( 1,2)/-100./ , FLLN( 2,2)/ 0./ , + + FLLN( 3,2)/ .015/ , FLLN( 4,2)/ -3./ , FLLN( 5,2)/ 0./ , + + FLLN( 6,2)/ 0./ +C +C (FLLB(I,3),I=1,10) and (FLLN(I,3),I=1,6) define the label below the +C grid. The name, in FLLB(1,3), and the line text, in FLLN(4,3), must +C be filled in by AGINIT. +C + DATA FLLB( 1,3)/ 0./ , FLLB( 2,3)/ 0./ , FLLB( 3,3)/ .5/ , + + FLLB( 4,3)/ 0./ , FLLB( 5,3)/ 0./ , FLLB( 6,3)/-.015/ , + + FLLB( 7,3)/ 0./ , FLLB( 8,3)/ 0./ , FLLB( 9,3)/ 1./ , + + FLLB(10,3)/ 3./ , FLLN( 1,3)/-100./ , FLLN( 2,3)/ 0./ , + + FLLN( 3,3)/ .015/ , FLLN( 4,3)/ -1./ , FLLN( 5,3)/ 1./ , + + FLLN( 6,3)/ 0./ +C +C (FLLB(I,4),I=1,10) and (FLLN(I,4),I=1,6) define the label above the +C grid. The name, in FLLB(1,4), and the line text, in FLLN(4,4), must +C be filled in by AGINIT. +C + DATA FLLB( 1,4)/ 0./ , FLLB( 2,4)/ 0./ , FLLB( 3,4)/ .5/ , + + FLLB( 4,4)/ 1./ , FLLB( 5,4)/ 0./ , FLLB( 6,4)/+.020/ , + + FLLB( 7,4)/ 0./ , FLLB( 8,4)/ 0./ , FLLB( 9,4)/ 1./ , + + FLLB(10,4)/ 4./ , FLLN( 1,4)/+100./ , FLLN( 2,4)/ 0./ , + + FLLN( 3,4)/ .020/ , FLLN( 4,4)/ -3./ , FLLN( 5,4)/ 0./ , + + FLLN( 6,4)/ 0./ +C +C Certain secondary parameters must be initialized to prevent bombing. +C + DATA QBTP(1)/ 0./ , QBTP(2)/ 0./ , QBTP(3)/ 0./ , QBTP(4)/ 0./ + DATA BASE(1)/ 0./ , BASE(2)/ 0./ , BASE(3)/ 0./ , BASE(4)/ 0./ + DATA QMNT(1)/ 0./ , QMNT(2)/ 0./ , QMNT(3)/ 0./ , QMNT(4)/ 0./ + DATA QLTP(1)/ 0./ , QLTP(2)/ 0./ , QLTP(3)/ 0./ , QLTP(4)/ 0./ + DATA QLEX(1)/ 0./ , QLEX(2)/ 0./ , QLEX(3)/ 0./ , QLEX(4)/ 0./ + DATA QLFL(1)/ 0./ , QLFL(2)/ 0./ , QLFL(3)/ 0./ , QLFL(4)/ 0./ + DATA QCIM(1)/ 0./ , QCIM(2)/ 0./ , QCIM(3)/ 0./ , QCIM(4)/ 0./ + DATA QCIE(1)/ 0./ , QCIE(2)/ 0./ , QCIE(3)/ 0./ , QCIE(4)/ 0./ + DATA RFNL(1)/ 0./ , RFNL(2)/ 0./ , RFNL(3)/ 0./ , RFNL(4)/ 0./ + DATA QLUA(1)/ 0./ , QLUA(2)/ 0./ , QLUA(3)/ 0./ , QLUA(4)/ 0./ +C +C SMRL and ISLD are set by the routine AGINIT (which see, below). +C +C MWCL, MWCM, MWCE, MDLA, MWCD, and MWDQ are the minimum widths of label +C characters, mantissa characters, exponent characters, label-to-axis +C distances, dash-pattern characters, and dash-pattern spaces, respect- +C ively (in the plotter coordinate system). +C + DATA MWCL /8/, MWCM /8/, MWCE /8/, MDLA /8/, MWCD /8/, MWDQ /8/ +C +C INIF is an initialization flag, set non-zero to indicate that the +C routine AGINIT has been executed to set the values of AUTOGRAPH +C parameters which, for one reason or another, cannot be preset by +C this block data routine. +C + DATA INIF / 0 / +C +C CHS1 and CHS2 are used within AUTOGRAPH when manipulating character +C strings retrieved by calls to AGGTCH. They need not be preset. +C +C LNIC is the second dimension of the array (INCH) which holds an index +C of the character strings stored by AGSTCH. +C + DATA LNIC / 50 / +C +C INCH is an index of character strings currently stored in CHRA. Each +C entry has the following format: +C +C INCH(1,I), if non-zero, is the index, in the array CHRA, of the +C first character of the Ith character string. +C +C INCH(2,I) is the length of the Ith character string. +C + DATA (INCH(1,I),I=1,50) / 50*0 / + DATA (INCH(2,I),I=1,50) / 50*0 / +C +C LNCA is the size of the array (CHRA) in which AGSTCH stores character +C strings. +C + DATA LNCA / 2000 / +C +C INCA is the index of the last character used in CHRA. +C + DATA INCA / 0 / +C +C CHRA holds character strings stored by AGSTCH. It need not be pre-set +C to anything. +C + END diff --git a/sys/gio/ncarutil/autograph/agdflt.f b/sys/gio/ncarutil/autograph/agdflt.f new file mode 100644 index 00000000..87b0ca45 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agdflt.f @@ -0,0 +1,690 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C +c +noao: blockdata rewritten to be run time initialization +c BLOCK DATA AGDFLT + subroutine agdflt +C +C The block data subroutine AGDFLT defines the default values of those +C AUTOGRAPH parameters which can be declared in a DATA statement. See +C AGINIT for code initializing other AUTOGRAPH parameters. +C +C Following are declarations of all the AUTOGRAPH common blocks. +C +C The following common block contains the AUTOGRAPH control parameters, +C all of which are real. If it is changed, all of AUTOGRAPH (especially +C the routine AGSCAN) must be examined for possible side effects. +C + COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) , + + XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD , + + XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH , + + YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH , + + QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4), + + BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4), + + QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4), + + QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) , + + QODP,QCDP,WOCD,WODQ,QDSH(26) , + + QDLB,QBIM,FLLB(10,8),QBAN , + + QLLN,TCLN,QNIM,FLLN(6,16),QNAN , + + XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW , + + XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP , + + XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4), + + QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4), + + QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4), + + WNLE(4),QLUA(4) , + + RBOX(6),DBOX(6,4),SBOX(6,4) +C +C The following common block contains other AUTOGRAPH variables, both +C real and integer, which are not control parameters. +C + COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ , + + INIF +C +C The following common block contains other AUTOGRAPH variables, of +C type character. +C + COMMON /AGOCHP/ CHS1,CHS2 +C +c+noao +c CHARACTER*504 CHS1,CHS2 + CHARACTER*500 CHS1,CHS2 +c-noao +C +C The following common blocks contain variables which are required for +C the character-storage-and-retrieval scheme of AUTOGRAPH. +C + COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA +C + COMMON /AGCHR2/ CHRA(2000) +C + CHARACTER*1 CHRA +C +c +noao: logical flag added to prevent "over-initialization" + logical first + data first /.true./ + call utilbd + if (.not. first) return + first = .false. +c -noao +C --------------------------------------------------------------------- +C +C Following are declarations of default values of variables in the +C AUTOGRAPH common blocks. +C +C --------------------------------------------------------------------- +C +C QFRA defines the control parameter 'FRAME.', which specifies when, if +C ever, the EZ... routines are to call FRAME to advance to a new frame. +C +c DATA QFRA / 1. / + QFRA = 1. +C +C QSET defines the control parameter 'SET.', which determines how the +C last call to the plot-package routine "SET" is to affect AUTOGRAPH. +C +c DATA QSET / 1. / + QSET = 1. +C +C QROW defines the control parameter 'ROW.', which determines how the x +C and y input arrays (in calls to AGSTUP and AGCURV) are to be used. +C +c DATA QROW / 1. / + QROW = 1. +C +C QIXY defines the control parameter 'INVERT.', which, if set non-zero, +C causes the routines AGSTUP and AGCURV to behave as if the arguments +C defining the x and y data had been interchanged. +C +c DATA QIXY / 0. / + QIXY = 0. +C +C QWND defines the control parameter 'WINDOW.', which, if set non-zero, +C causes curves drawn to be scissored by the edge of the curve window. +C +c DATA QWND / 0. / + QWND = 0. +C +C QBAC defines the control parameter 'BACKGROUND.', which can be given +C any of four values to set up four specific types of plot background. +C +c DATA QBAC / 1. / + QBAC = 1. +C +C SVAL defines the control parameters 'NULL/1.' and 'NULL/2.', which are +C used in various ways by AUTOGRAPH. +C +c DATA SVAL(1) / 1E36 / , SVAL(2) / 2E36 / + SVAL(1) = 1E36 + SVAL(2) = 2E36 +C +C XLGF, XRGF, YBGF, and YTGF define the parameter-group 'GRAPH.'; they +C specify the position of the graph window within the plotter frame. +C +c DATA XLGF / 0. / , XRGF / 1. / , YBGF / 0. / , YTGF / 1. / + XLGF = 0. + XRGF = 1. + YBGF = 0. + YTGF = 1. +C +C XLGD, XRGD, YBGD, and YTGD define the first four parameters in the +C group 'GRID.'; they specify the position of the grid window within +C the graph window. +C +c DATA XLGD / .15 / , XRGD / .95 / , YBGD / .15 / , YTGD / .95 / + XLGD = .15 + XRGD = .95 + YBGD = .15 + YTGD = .95 +C +C SOGD defines the control parameter 'GRID/SHAPE.', which defines the +C shape of the grid window. +C +c DATA SOGD / 0. / + SOGD = 0. +C +C XMIN and XMAX define the control parameters 'X/MIN.' and 'X/MAX.', +C which determine how minimum and maximum values of x are to be chosen. +C Null values imply that AUTOGRAPH is to choose real values; non-null +C values are the actual values to be used (perhaps after rounding). +C +c DATA XMIN / 1E36 / , XMAX / 1E36 / + XMIN = 1E36 + XMAX = 1E36 +C +C QLUX defines the control parameter 'X/LOG.', which is set non-zero to +C specify that the horizontal axis is to be logarithmic. +C +c DATA QLUX / 0. / + QLUX = 0. +C +C QOVX defines the control parameter 'X/ORDER.', which is set non-zero +C to flip the horizontal axis end-for-end. +C +c DATA QOVX / 0. / + QOVX = 0. +C +C QCEX defines the control parameter 'X/NICE.', which determines which, +C if either, of the horizontal axes is to have "nice" (rounded) values +C at its ends. +C +c DATA QCEX / -1. / + QCEX = -1. +C +C XLOW and XHGH define the control parameters 'X/SMALLEST.' and +C 'X/LARGEST.'; they come into play only when XMIN and/or XMAX are null +C and they are non-null, in which case they set limits on the range of +C x data to be considered when choosing the minimum and/or maximum. +C +c DATA XLOW / 1E36 / , XHGH / 1E36 / + XLOW = 1E36 + XHGH = 1E36 +C +C YMIN and YMAX define the control parameters 'Y/MIN.' and 'Y/MAX.', +C which determine how minimum and maximum values of y are to be chosen. +C Null values imply that AUTOGRAPH is to choose real values; non-null +C values are the actual values to be used (perhaps after rounding). +C +c DATA YMIN / 1E36 / , YMAX / 1E36 / + YMIN = 1E36 + YMAX = 1E36 +C +C QLUY defines the control parameter 'Y/LOG.', which is set non-zero to +C specify that the horizontal axis is to be logarithmic. +C +c DATA QLUY / 0. / + QLUY = 0. +C +C QOVY defines the control parameter 'Y/ORDER.', which is set non-zero +C to flip the horizontal axis end-for-end. +C +c DATA QOVY / 0. / + QOVY = 0. +C +C QCEY defines the control parameter 'Y/NICE.', which determines which, +C if either, of the horizontal axes is to have "nice" (rounded) values +C at its ends. +C +c DATA QCEY / -1. / + QCEY = -1. +C +C YLOW and YHGH define the control parameters 'Y/SMALLEST.' and +C 'Y/LARGEST.'; they come into play only when YMIN and/or YMAX are null +C and they are non-null, in which case they set limits on the range of +C y data to be considered when choosing the minimum and/or maximum. +C +c DATA YLOW / 1E36 / , YHGH / 1E36 / + YLOW = 1E36 + YHGH = 1E36 +C +C QDAX(i) defines the control parameters 'AXIS/s/CONTROL.' (i=1 implies +C s='LEFT', i=2 implies s='RIGHT', i=3 implies s='BOTTOM', i=4 implies +C s='TOP'). Each of these specifies whether or not a given axis will +C be drawn or not and what liberties may be taken with numeric labels +C on the axis. +C +c DATA QDAX(1)/ 4. / , QDAX(2)/ 4. / , QDAX(3)/ 4. / , QDAX(4)/ 4. / + QDAX(1) = 4. + QDAX(2) = 4. + QDAX(3) = 4. + QDAX(4) = 4. +C +C Each QSPA(i) defines a control parameter 'AXIS/s/LINE.', which says +C whether or not the line portion of a particular axis is to be drawn. +C +c DATA QSPA(1)/ 0. / , QSPA(2)/ 0. / , QSPA(3)/ 0. / , QSPA(4)/ 0. / + QSPA(1) = 0. + QSPA(2) = 0. + QSPA(3) = 0. + QSPA(4) = 0. +C +C Each PING(i) defines a control parameter 'AXIS/s/INTERSECTION/GRID.', +C which may be used to move a particular axis to a specified position. +C +c DATA PING(1)/1E36/ , PING(2)/1E36/ , PING(3)/1E36/ , PING(4)/1E36/ + PING(1) = 1E36 + PING(2) = 1E36 + PING(3) = 1E36 + PING(4) = 1E36 +C +C Each PINU(i) defines a control parameter 'AXIS/s/INTERSECTION/USER.', +C which may be used to move a particular axis to a specified position. +C +c DATA PINU(1)/1E36/ , PINU(2)/1E36/ , PINU(3)/1E36/ , PINU(4)/1E36/ + PINU(1) = 1E36 + PINU(2) = 1E36 + PINU(3) = 1E36 + PINU(4) = 1E36 +C +C Each FUNS(i) defines a control parameter 'AXIS/s/FUNCTION.', which is +C used within a user-supplied version of AGUTOL to select a particular +C uset-system-to-label-system mapping for a particular axis. The +C default value selects the identity mapping. +C +c DATA FUNS(1)/ 0. / , FUNS(2)/ 0. / , FUNS(3)/ 0. / , FUNS(4)/ 0. / + FUNS(1) = 0. + FUNS(2) = 0. + FUNS(3) = 0. + FUNS(4) = 0. +C +C The values of QBTD(i), BASD(i), QMJD(i), QJDP(i), WMJL(i), and WMJR(i) +C together define the control-parameter group 'AXIS/s/TICKS/MAJOR.', +C which determines the positioning and appearance of the major ticks on +C a particular axis. +C +c DATA QBTD(1)/1E36/ , QBTD(2)/1E36/ , QBTD(3)/1E36/ , QBTD(4)/1E36/ +c DATA BASD(1)/1E36/ , BASD(2)/1E36/ , BASD(3)/1E36/ , BASD(4)/1E36/ +c DATA QMJD(1)/ 6. / , QMJD(2)/ 6. / , QMJD(3)/ 6. / , QMJD(4)/ 6. / +c DATA QJDP(1)/1E36/ , QJDP(2)/1E36/ , QJDP(3)/1E36/ , QJDP(4)/1E36/ +c DATA WMJL(1)/ 0. / , WMJL(2)/ 0. / , WMJL(3)/ 0. / , WMJL(4)/ 0. / +c DATA WMJR(1)/.015/ , WMJR(2)/.015/ , WMJR(3)/.015/ , WMJR(4)/.015/ + QBTD(1) = 1E36 + QBTD(2) = 1E36 + QBTD(3) = 1E36 + QBTD(4) = 1E36 + BASD(1) = 1E36 + BASD(2) = 1E36 + BASD(3) = 1E36 + BASD(4) = 1E36 + QMJD(1) = 6. + QMJD(2) = 6. + QMJD(3) = 6. + QMJD(4) = 6. + QJDP(1) = 1E36 + QJDP(2) = 1E36 + QJDP(3) = 1E36 + QJDP(4) = 1E36 + WMJL(1) = 0. + WMJL(2) = 0. + WMJL(3) = 0. + WMJL(4) = 0. + WMJR(1) = .015 + WMJR(2) = .015 + WMJR(3) = .015 + WMJR(4) = .015 +C +C The values of QMND(i), QNDP(i), WMNL(i), and WMNR(i) together define +C the control-parameter group 'AXIS/s/TICKS/MINOR.', which determines +C the positioning and appearance of the major ticks on a particular +C axis. +C +c DATA QMND(1)/1E36/ , QMND(2)/1E36/ , QMND(3)/1E36/ , QMND(4)/1E36/ +c DATA QNDP(1)/1E36/ , QNDP(2)/1E36/ , QNDP(3)/1E36/ , QNDP(4)/1E36/ +c DATA WMNL(1)/ 0. / , WMNL(2)/ 0. / , WMNL(3)/ 0. / , WMNL(4)/ 0. / +c DATA WMNR(1)/.010/ , WMNR(2)/.010/ , WMNR(3)/.010/ , WMNR(4)/.010/ + QMND(1) = 1E36 + QMND(2) = 1E36 + QMND(3) = 1E36 + QMND(4) = 1E36 + QNDP(1) = 1E36 + QNDP(2) = 1E36 + QNDP(3) = 1E36 + QNDP(4) = 1E36 + WMNL(1) = 0. + WMNL(2) = 0. + WMNL(3) = 0. + WMNL(4) = 0. + WMNR(1) = .010 + WMNR(2) = .010 + WMNR(3) = .010 + WMNR(4) = .010 +C +C The values of QLTD(i), QLED(i), QLFD(i), QLOF(i), QLOS(i), DNLA(i), +C WCLM(i), and WCLE(i) together define the control-parameter group +C 'AXIS/s/NUMERIC.', which determines the positioning and appearance of +C the numeric labels on a particular axis. +C +c DATA QLTD(1)/1E36/ , QLTD(2)/ 0./ , QLTD(3)/1E36/ , QLTD(4)/ 0./ +c DATA QLED(1)/1E36/ , QLED(2)/1E36/ , QLED(3)/1E36/ , QLED(4)/1E36/ +c DATA QLFD(1)/1E36/ , QLFD(2)/1E36/ , QLFD(3)/1E36/ , QLFD(4)/1E36/ +c DATA QLOF(1)/ 0. / , QLOF(2)/ 0. / , QLOF(3)/ 0. / , QLOF(4)/ 0. / +c DATA QLOS(1)/ 90./ , QLOS(2)/ 90./ , QLOS(3)/ 90./ , QLOS(4)/ 90./ +c DATA DNLA(1)/.015/ , DNLA(2)/.015/ , DNLA(3)/.015/ , DNLA(4)/.015/ +c DATA WCLM(1)/.015/ , WCLM(2)/.015/ , WCLM(3)/.015/ , WCLM(4)/.015/ +c DATA WCLE(1)/.010/ , WCLE(2)/.010/ , WCLE(3)/.010/ , WCLE(4)/.010/ + QLTD(1) = 1E36 + QLTD(2) = 0. + QLTD(3) = 1E36 + QLTD(4) = 0. + QLED(1) = 1E36 + QLED(2) = 1E36 + QLED(3) = 1E36 + QLED(4) = 1E36 + QLFD(1) = 1E36 + QLFD(2) = 1E36 + QLFD(3) = 1E36 + QLFD(4) = 1E36 + QLOF(1) = 0. + QLOF(2) = 0. + QLOF(3) = 0. + QLOF(4) = 0. + QLOS(1) = 90. + QLOS(2) = 90. + QLOS(3) = 90. + QLOS(4) = 90. + DNLA(1) = .015 + DNLA(2) = .015 + DNLA(3) = .015 + DNLA(4) = .015 + WCLM(1) = .015 + WCLM(2) = .015 + WCLM(3) = .015 + WCLM(4) = .015 + WCLE(1) = .010 + WCLE(2) = .010 + WCLE(3) = .010 + WCLE(4) = .010 +C +C QODP defines the control parameter 'DASH/SELECTOR.', the sign of which +C determines which set of dash patterns is used by EZMY and EZMXY (the +C alphabetic set or the user-specified set); if the user-specified set +C is selected, the magnitude of QODP determines how many of them are to +C be used. +C +c DATA QODP / 1. / + QODP = 1. +C +C QCDP defines the control parameter 'DASH/LENGTH.', which specifies the +C assumed length of dash patterns tendered to AUTOGRAPH. +C +c DATA QCDP / 8. / + QCDP = 8. +C +C WOCD and WODQ define the control parameters 'DASH/CHARACTER.' and +C 'DASH/DOLLAR-QUOTE.', which specify the widths of characters used in +C character-string dash patterns. +C +c DATA WOCD / .010 / , WODQ / .010 / + WOCD = .010 + WODQ = .010 +C +C QDSH defines the control-parameter group 'DASH/PATTERN.'. Each value, +C if positive, defines a binary dash pattern, and, if negative, serves +C as an identifier in retrieving a character-string dash pattern. +C +c DATA QDSH / 26*65535. / + do 20, ijk = 1, 26 + 20 QDSH(ijk) = 65535. +C +C QDLB defines the control parameter 'LABEL/CONTROL.', which specifies +C what may be done with informational labels in response to overlap +C problems. +C +c DATA QDLB /2./ + QDLB = 2. +C +C QBIM defines the control parameter 'LABEL/BUFFER/LENGTH.' and must +C be equal to the second dimension of the array FLLB. +C +c DATA QBIM / 8. / + QBIM = 8. +C +C QBAN defines the control parameter 'LABEL/NAME.'; its value is really +C a pointer into the label list. The default value, zero, means that +C the pointer has not been set. +C +c DATA QBAN / 0. / + QBAN = 0. +C +C QLLN defines the control parameter 'LINE/MAXIMUM.' - the assumed +C maximum length of character strings intended for use as the text of a +C line of a label. +C +c DATA QLLN /40./ + QLLN = 40. +C +C TCLN defines the control parameter 'LINE/TERMINATOR.' - which is used +C to mark the end of character strings intended for use as the text of a +C line of a label. It is initialized in AGINIT. +C +C QNIM defines the control parameter 'LINE/BUFFER/LENGTH.' and must be +C equal to the second dimension of FLLN. +C +c DATA QNIM / 16. / + QNIM = 16. +C +C QNAN defines the control parameter 'LINE/NUMBER.'; its value is really +C a pointer into the line list. The default value, zero, says that the +C pointer has not been set. +C +c DATA QNAN / 0. / + QNAN = 0. +C +C (FLLB(I,1),I=1,10) and (FLLN(I,1),I=1,6) define the label to the left +C of the grid. The name, in FLLB(1,1), and the line text, in FLLN(4,1), +C must be filled in by AGINIT. +C +c DATA FLLB( 1,1)/ 0./ , FLLB( 2,1)/ 0./ , FLLB( 3,1)/ 0./ , +c + FLLB( 4,1)/ .5/ , FLLB( 5,1)/-.015/ , FLLB( 6,1)/ 0./ , +c + FLLB( 7,1)/ 90./ , FLLB( 8,1)/ 0./ , FLLB( 9,1)/ 1./ , +c + FLLB(10,1)/ 1./ , FLLN( 1,1)/+100./ , FLLN( 2,1)/ 0./ , +c + FLLN( 3,1)/ .015/ , FLLN( 4,1)/ -2./ , FLLN( 5,1)/ 1./ , +c + FLLN( 6,1)/ 0./ + FLLB( 1,1) = 0. + FLLB( 2,1) = 0. + FLLB( 3,1) = 0. + FLLB( 4,1) = .5 + FLLB( 5,1) = -.015 + FLLB( 6,1) = 0. + FLLB( 7,1) = 90. + FLLB( 8,1) = 0. + FLLB( 9,1) = 1. + FLLB(10,1) = 1. + FLLN( 1,1) = +100. + FLLN( 2,1) = 0. + FLLN( 3,1) = .015 + FLLN( 4,1) = -2. + FLLN( 5,1) = 1. + FLLN( 6,1) = 0. +C +C (FLLB(I,2),I=1,10) and (FLLN(I,2),I=1,6) define the label to the right +C of the grid. The name, in FLLB(1,2), and the line text, in FLLN(4,2), +C must be filled in by AGINIT. +C +c DATA FLLB( 1,2)/ 0./ , FLLB( 2,2)/ 0./ , FLLB( 3,2)/ 1./ , +c + FLLB( 4,2)/ .5/ , FLLB( 5,2)/+.015/ , FLLB( 6,2)/ 0./ , +c + FLLB( 7,2)/ 90./ , FLLB( 8,2)/ 0./ , FLLB( 9,2)/ 1./ , +c + FLLB(10,2)/ 2./ , FLLN( 1,2)/-100./ , FLLN( 2,2)/ 0./ , +c + FLLN( 3,2)/ .015/ , FLLN( 4,2)/ -3./ , FLLN( 5,2)/ 0./ , +c + FLLN( 6,2)/ 0./ + FLLB( 1,2) = 0. + FLLB( 2,2) = 0. + FLLB( 3,2) = 1. + FLLB( 4,2) = .5 + FLLB( 5,2) = +.015 + FLLB( 6,2) = 0. + FLLB( 7,2) = 90. + FLLB( 8,2) = 0. + FLLB( 9,2) = 1. + FLLB(10,2) = 2. + FLLN( 1,2) = -100. + FLLN( 2,2) = 0. + FLLN( 3,2) = .015 + FLLN( 4,2) = -3. + FLLN( 5,2) = 0. + FLLN( 6,2) = 0. +C +C (FLLB(I,3),I=1,10) and (FLLN(I,3),I=1,6) define the label below the +C grid. The name, in FLLB(1,3), and the line text, in FLLN(4,3), must +C be filled in by AGINIT. +C +c DATA FLLB( 1,3)/ 0./ , FLLB( 2,3)/ 0./ , FLLB( 3,3)/ .5/ , +c + FLLB( 4,3)/ 0./ , FLLB( 5,3)/ 0./ , FLLB( 6,3)/-.015/ , +c + FLLB( 7,3)/ 0./ , FLLB( 8,3)/ 0./ , FLLB( 9,3)/ 1./ , +c + FLLB(10,3)/ 3./ , FLLN( 1,3)/-100./ , FLLN( 2,3)/ 0./ , +c + FLLN( 3,3)/ .015/ , FLLN( 4,3)/ -1./ , FLLN( 5,3)/ 1./ , +c + FLLN( 6,3)/ 0./ + FLLB( 1,3) = 0. + FLLB( 2,3) = 0. + FLLB( 3,3) = .5 + FLLB( 4,3) = 0. + FLLB( 5,3) = 0. + FLLB( 6,3) = -.015 + FLLB( 7,3) = 0. + FLLB( 8,3) = 0. + FLLB( 9,3) = 1. + FLLB(10,3) = 3. + FLLN( 1,3) = -100. + FLLN( 2,3) = 0. + FLLN( 3,3) = .015 + FLLN( 4,3) = -1. + FLLN( 5,3) = 1. + FLLN( 6,3) = 0. +C +C (FLLB(I,4),I=1,10) and (FLLN(I,4),I=1,6) define the label above the +C grid. The name, in FLLB(1,4), and the line text, in FLLN(4,4), must +C be filled in by AGINIT. +C +c DATA FLLB( 1,4)/ 0./ , FLLB( 2,4)/ 0./ , FLLB( 3,4)/ .5/ , +c + FLLB( 4,4)/ 1./ , FLLB( 5,4)/ 0./ , FLLB( 6,4)/+.020/ , +c + FLLB( 7,4)/ 0./ , FLLB( 8,4)/ 0./ , FLLB( 9,4)/ 1./ , +c + FLLB(10,4)/ 4./ , FLLN( 1,4)/+100./ , FLLN( 2,4)/ 0./ , +c + FLLN( 3,4)/ .020/ , FLLN( 4,4)/ -3./ , FLLN( 5,4)/ 0./ , +c + FLLN( 6,4)/ 0./ + FLLB( 1,4) = 0. + FLLB( 2,4) = 0. + FLLB( 3,4) = .5 + FLLB( 4,4) = 1. + FLLB( 5,4) = 0. + FLLB( 6,4) = +.020 + FLLB( 7,4) = 0. + FLLB( 8,4) = 0. + FLLB( 9,4) = 1. + FLLB(10,4) = 4. + FLLN( 1,4) = +100. + FLLN( 2,4) = 0. + FLLN( 3,4) = .020 + FLLN( 4,4) = -3. + FLLN( 5,4) = 0. + FLLN( 6,4) = 0. +C +C Certain secondary parameters must be initialized to prevent bombing. +C +c DATA QBTP(1)/ 0./ , QBTP(2)/ 0./ , QBTP(3)/ 0./ , QBTP(4)/ 0./ +c DATA BASE(1)/ 0./ , BASE(2)/ 0./ , BASE(3)/ 0./ , BASE(4)/ 0./ +c DATA QMNT(1)/ 0./ , QMNT(2)/ 0./ , QMNT(3)/ 0./ , QMNT(4)/ 0./ +c DATA QLTP(1)/ 0./ , QLTP(2)/ 0./ , QLTP(3)/ 0./ , QLTP(4)/ 0./ +c DATA QLEX(1)/ 0./ , QLEX(2)/ 0./ , QLEX(3)/ 0./ , QLEX(4)/ 0./ +c DATA QLFL(1)/ 0./ , QLFL(2)/ 0./ , QLFL(3)/ 0./ , QLFL(4)/ 0./ +c DATA QCIM(1)/ 0./ , QCIM(2)/ 0./ , QCIM(3)/ 0./ , QCIM(4)/ 0./ +c DATA QCIE(1)/ 0./ , QCIE(2)/ 0./ , QCIE(3)/ 0./ , QCIE(4)/ 0./ +c DATA RFNL(1)/ 0./ , RFNL(2)/ 0./ , RFNL(3)/ 0./ , RFNL(4)/ 0./ +c DATA QLUA(1)/ 0./ , QLUA(2)/ 0./ , QLUA(3)/ 0./ , QLUA(4)/ 0./ + QBTP(1) = 0. + QBTP(2) = 0. + QBTP(3) = 0. + QBTP(4) = 0. + BASE(1) = 0. + BASE(2) = 0. + BASE(3) = 0. + BASE(4) = 0. + QMNT(1) = 0. + QMNT(2) = 0. + QMNT(3) = 0. + QMNT(4) = 0. + QLTP(1) = 0. + QLTP(2) = 0. + QLTP(3) = 0. + QLTP(4) = 0. + QLEX(1) = 0. + QLEX(2) = 0. + QLEX(3) = 0. + QLEX(4) = 0. + QLFL(1) = 0. + QLFL(2) = 0. + QLFL(3) = 0. + QLFL(4) = 0. + QCIM(1) = 0. + QCIM(2) = 0. + QCIM(3) = 0. + QCIM(4) = 0. + QCIE(1) = 0. + QCIE(2) = 0. + QCIE(3) = 0. + QCIE(4) = 0. + RFNL(1) = 0. + RFNL(2) = 0. + RFNL(3) = 0. + RFNL(4) = 0. + QLUA(1) = 0. + QLUA(2) = 0. + QLUA(3) = 0. + QLUA(4) = 0. +C +C SMRL and ISLD are set by the routine AGINIT (which see, below). +C +C MWCL, MWCM, MWCE, MDLA, MWCD, and MWDQ are the minimum widths of label +C characters, mantissa characters, exponent characters, label-to-axis +C distances, dash-pattern characters, and dash-pattern spaces, respect- +C ively (in the plotter coordinate system). +C +c DATA MWCL /8/, MWCM /8/, MWCE /8/, MDLA /8/, MWCD /8/, MWDQ /8/ + MWCL = 8 + MWCM = 8 + MWCE = 8 + MDLA = 8 + MWCD = 8 + MWDQ = 8 +C +C INIF is an initialization flag, set non-zero to indicate that the +C routine AGINIT has been executed to set the values of AUTOGRAPH +C parameters which, for one reason or another, cannot be preset by +C this block data routine. +C +c DATA INIF / 0 / + INIF = 0 +C +C CHS1 and CHS2 are used within AUTOGRAPH when manipulating character +C strings retrieved by calls to AGGTCH. They need not be preset. +C +C LNIC is the second dimension of the array (INCH) which holds an index +C of the character strings stored by AGSTCH. +C +c DATA LNIC / 50 / + LNIC = 50 +C +C INCH is an index of character strings currently stored in CHRA. Each +C entry has the following format: +C +C INCH(1,I), if non-zero, is the index, in the array CHRA, of the +C first character of the Ith character string. +C +C INCH(2,I) is the length of the Ith character string. +C +c DATA (INCH(1,I),I=1,50) / 50*0 / +c DATA (INCH(2,I),I=1,50) / 50*0 / + do 10, ijk = 1, 50 + inch (1, ijk) = 0 + inch (2, ijk) = 0 + 10 continue +C +C LNCA is the size of the array (CHRA) in which AGSTCH stores character +C strings. +C +c DATA LNCA / 2000 / + LNCA = 2000 +C +C INCA is the index of the last character used in CHRA. +C +c DATA INCA / 0 / + INCA = 0 +C +C CHRA holds character strings stored by AGSTCH. It need not be pre-set +C to anything. +C + return +c + entry initag + first = .true. + END diff --git a/sys/gio/ncarutil/autograph/agdlch.f b/sys/gio/ncarutil/autograph/agdlch.f new file mode 100644 index 00000000..78a96c8f --- /dev/null +++ b/sys/gio/ncarutil/autograph/agdlch.f @@ -0,0 +1,60 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGDLCH (IDCS) +C +C This routine deletes character strings previously stored by the +C routine AGSTCH (which see). It has the following argument: +C +C -- IDCS is the identifying integer returned by AGSTCH when the string +C was stored. +C +C The following common blocks contain variables which are required for +C the character-storage-and-retrieval scheme of AUTOGRAPH. +C + COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA +C + COMMON /AGCHR2/ CHRA(2000) +C + CHARACTER*1 CHRA +C +C Only if the identifier is between -LNIC and -1, inclusive, was the +C string ever stored, so that it needs to be deleted. If the string is +C the last one in CHRA, we can just set INCA to point to the position +C preceding it; otherwise, we zero out the string but don't bother to +C collapse CHRA, which will happen in AGSTCH when the space is needed +C again. In either case, the index entry in INCH is zeroed. +C + IF (IDCS.GE.(-LNIC).AND.IDCS.LE.(-1)) THEN + I=-IDCS + J=INCH(1,I) + IF (J.GT.0) THEN + K=J+INCH(2,I)-1 + IF (K.EQ.INCA) THEN + INCA=J-1 + ELSE + DO 101 L=J,K + CHRA(L)=CHAR(0) + 101 CONTINUE + END IF + INCH(1,I)=0 + END IF + END IF +C +C Done. +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agdshn.f b/sys/gio/ncarutil/autograph/agdshn.f new file mode 100644 index 00000000..a20a5dfd --- /dev/null +++ b/sys/gio/ncarutil/autograph/agdshn.f @@ -0,0 +1,34 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + CHARACTER*16 FUNCTION AGDSHN (IDSH) +C +C The value of this function is the name of the dash pattern numbered +C IDSH - that is to say, the character string 'DASH/PATTERN/n.', where +C n is an integer between 1 and 99, equal to MAX0(1,MIN0(99,IDSH)). +C + AGDSHN='DASH/PATTERN/ .' +C + KDSH=MAX0(1,MIN0(99,IDSH)) +C + DO 101 I=15,14,-1 + AGDSHN(I:I)=CHAR(ICHAR('0')+MOD(KDSH,10)) + IF (KDSH.LE.9) GO TO 102 + KDSH=KDSH/10 + 101 CONTINUE +C + 102 RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agexax.f b/sys/gio/ncarutil/autograph/agexax.f new file mode 100644 index 00000000..b16e2319 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agexax.f @@ -0,0 +1,415 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGEXAX (IAXS,SVAL,UMIN,UMAX,NICE,QLUA,FUNS,QBTP,BASD, + + BASE,QMJD,QMND,QMNT,QLTD,QLTP,QLED,QLEX,QLFD, + + QLFL,QMIN,QMAX) +C + DIMENSION SVAL(2) +C +C The routine AGEXAX is used by AGSTUP to examine the parameters which +C determine how a given axis is tick-marked and labelled and to provide +C default values for missing ones. Its arguments are as follows: +C +C -- IAXS is the number of the axis being drawn - 1, 2, 3, or 4. +C +C -- SVAL is the array of special values. +C +C -- UMIN and UMAX are the minimum and maximum values along the axis, in +C the user coordinate system. Rounded values of UMIN and UMAX are +C returned in QMIN and QMAX if the following argument (NICE) is zero. +C +C -- NICE is a flag indicating whether rounded values of UMIN and UMAX +C are to be returned (NICE.EQ.0) or not (NICE.NE.0). +C +C -- LLUA and FUNS specify the user-system-to-label-system mapping along +C the axis. See the routine AGAXIS for a discussion of them. +C +C -- NBTP, BASD, BASE, and NMJD are used to determine the positioning of +C major tick marks in the label coordinate system. NBTP and BASE are +C described in the routine AGNUMB. BASD is the desired value of BASE +C supplied by the user. If BASD has a null value, BASE is computed +C by AGEXAX. NMJD is a user-supplied-or-defaulted parameter giving +C the approximate number of major ticks (and therefore the number of +C numeric labels) to be placed on the axis. +C +C -- NMND and NMNT are the desired and actual (to be determined) number +C of minor ticks per major division. See discussion in AGAXIS. +C +C -- NLTD, NLTP, NLED, NLEX, NLFD, and NLFL are desired and actual (to +C be determined) values of the parameters describing the form to be +C used for numeric labels. See discussion in AGNUMB. +C +C -- QMIN and QMAX are rounded values of UMIN and UMAX, returned only if +C NICE.EQ.0. +C +C The following common block contains AUTOGRAPH variables which are +C not control parameters. The only one used here is SMRL, which is a +C (machine-dependent) small real which, when added to a number in the +C range (1,10), will round it upward without seriously affecting the +C leading significant digits. The object of this is to get rid of +C strings of nines. +C + COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ , + + INIF +C +C The arrays BASP and NMNP specify possible default values for BASE and +C NMNT when NBTP.EQ.1. +C + DIMENSION BASP(5),NMNP(5) +C + DATA BASP(1) / 10. / , NMNP(1) / 1 / , + * BASP(2) / 5. / , NMNP(2) / 4 / , + * BASP(3) / 2. / , NMNP(3) / 1 / , + * BASP(4) / 1. / , NMNP(4) / 1 / , + * BASP(5) / .5 / , NMNP(5) / 4 / +C +C If the parameter NBTP is zero, tick marks and labels are suppressed. +C + NBTP=IFIX(QBTP) + IF (NBTP.EQ.0) RETURN +C +C Unpack integer values from floating-point arguments. +C + LLUA=IFIX(QLUA) + NMJD=IFIX(QMJD) + IF (QMND.NE.SVAL(1).AND.QMND.NE.SVAL(2)) NMND=IFIX(QMND) + NMNT=0 + IF (QLTD.NE.SVAL(1).AND.QLTD.NE.SVAL(2)) NLTD=IFIX(QLTD) + NLTP=0 + IF (QLED.NE.SVAL(1).AND.QLED.NE.SVAL(2)) NLED=IFIX(QLED) + NLEX=0 + IF (QLFD.NE.SVAL(1).AND.QLFD.NE.SVAL(2)) NLFD=IFIX(QLFD) + NLFL=0 +C +C Compute label-coordinate-system values at the ends of the axis. +C + CALL AGUTOL (IAXS,FUNS,1,UMIN,VMIN) + CALL AGUTOL (IAXS,FUNS,1,UMAX,VMAX) +C +C Error if the label-coordinate-system values are equal. +C + IF (VMIN.EQ.VMAX) GO TO 901 +C +C If a special value is specified for the parameter BASD, AGEXAX must +C pick a value for the parameter BASE. +C + IF (BASD.EQ.SVAL(1).OR.BASD.EQ.SVAL(2)) GO TO 101 +C +C The user has specified a value for the parameter BASE. If that value +C is less than or equal to zero, tick marks and labels are suppressed. +C + BASE=AMAX1(0.,BASD) + IF (BASE.EQ.0.) RETURN + NMNT=0 + GO TO 108 +C +C Pick a value for the parameter BASE, depending on the number type. +C + 101 GO TO (102,105,106) , NBTP +C +C Major ticks and labels are at numbers of the form (-) BASE * EXMU. +C + 102 NMJD=MAX0(0,NMJD) +C +C Compute an approximate value for BASE. +C + FTMP=ABS(VMAX-VMIN)/FLOAT(NMJD+1) +C +C Reduce the approximate value to the form FTMP * 10 ** ITMP. +C + ASSIGN 103 TO JMP1 + GO TO 200 +C +C Pick a reasonable value for BASE (1., 2., OR 5. * 10**ITMP). +C + 103 DO 104 I=1,5 + IF (FTMP.LT.BASP(I)) GO TO 104 + BASE=BASP(I)*SNGL(10.D0**ITMP) + NMNT=NMNP(I) + GO TO 107 + 104 CONTINUE +C +C Major ticks and labels are at numbers of the form (-) BASE * 10**EXMU. +C + 105 BASE=1. + NMNT=8 + GO TO 107 +C +C Major ticks and labels are at numbers of the form (-) BASE**EXMU. +C + 106 BASE=10. + NMNT=8 +C + 107 IF (BASD.EQ.SVAL(2)) BASD=BASE +C + 108 IF (QMND.NE.SVAL(1).AND.QMND.NE.SVAL(2)) NMNT=MAX0(0,NMND) + IF (QMND.EQ.SVAL(2)) QMND=FLOAT(NMNT) +C +C If the user wants nice values at the axis ends, reset UMIN and UMAX. +C + IF (NICE.NE.0) GO TO 115 +C + LOOP=0 +C + WMIN=VMIN + WMAX=VMAX +C + GO TO (109,110,112) , NBTP +C + 109 EMIN=VMIN/BASE+.5+SIGN(.5,VMIN-VMAX) + EMIN=EMIN-.5+SIGN(.5,EMIN)-SIGN(SMRL*EMIN,VMIN-VMAX) + WMIN=BASE*(EMIN-AMOD(EMIN,1.)) + EMAX=VMAX/BASE+.5+SIGN(.5,VMAX-VMIN) + EMAX=EMAX-.5+SIGN(.5,EMAX)-SIGN(SMRL*EMAX,VMAX-VMIN) + WMAX=BASE*(EMAX-AMOD(EMAX,1.)) + GO TO 114 +C + 110 IF (VMIN.EQ.0.) GO TO 111 + EMIN=ALOG10(ABS(VMIN)/BASE)+.5+SIGN(.5,VMIN*(VMIN-VMAX)) + EMIN=EMIN-.5+SIGN(.5,EMIN)-SIGN(SMRL*EMIN,VMIN*(VMIN-VMAX)) + WMIN=SIGN(BASE,VMIN)*10.**(EMIN-AMOD(EMIN,1.)) + 111 IF (VMAX.EQ.0.) GO TO 114 + EMAX=ALOG10(ABS(VMAX)/BASE)+.5+SIGN(.5,VMAX*(VMAX-VMIN)) + EMAX=EMAX-.5+SIGN(.5,EMAX)-SIGN(SMRL*EMAX,VMAX*(VMAX-VMIN)) + WMAX=SIGN(BASE,VMAX)*10.**(EMAX-AMOD(EMAX,1.)) + GO TO 114 +C + 112 IF (BASE.EQ.1.) GO TO 115 + IF (VMIN.EQ.0.) GO TO 113 + EMIN=ALOG10(ABS(VMIN))/ALOG10(BASE)+.5+SIGN(.5,VMIN*(VMIN-VMAX)) + EMIN=EMIN-.5+SIGN(.5,EMIN)-SIGN(SMRL*EMIN,VMIN*(VMIN-VMAX)) + WMIN=SIGN(1.,VMIN)*BASE**(EMIN-AMOD(EMIN,1.)) + 113 IF (VMAX.EQ.0.) GO TO 114 + EMAX=ALOG10(ABS(VMAX))/ALOG10(BASE)+.5+SIGN(.5,VMAX*(VMAX-VMIN)) + EMAX=EMAX-.5+SIGN(.5,EMAX)-SIGN(SMRL*EMAX,VMAX*(VMAX-VMIN)) + WMAX=SIGN(1.,VMAX)*BASE**(EMAX-AMOD(EMAX,1.)) +C +C Re-compute the user-coordinate-system minimum and maximum values. +C + 114 CALL AGUTOL (IAXS,FUNS,-1,WMIN,QMIN) + CALL AGUTOL (IAXS,FUNS,-1,WMAX,QMAX) +C +C Test for problems with nice values chosen. +C + IF (QMIN.LT.QMAX) GO TO 140 + IF (QMIN.GT.QMAX) GO TO 901 +C +C We have a pathological case - user values are clustered very close to +C a label position. See what can be done about it. +C + LOOP=LOOP+1 + IF (LOOP.GT.1) GO TO 901 +C + GO TO (137,138,139) , NBTP +C + 137 VMIN=VMIN+SIGN(BASE,VMIN-VMAX) + VMAX=VMAX+SIGN(BASE,VMAX-VMIN) + GO TO 109 +C + 138 VMIN=VMIN*10.**SIGN(1.,VMIN*(VMIN-VMAX)) + VMAX=VMAX*10.**SIGN(1.,VMAX*(VMAX-VMIN)) + GO TO 110 +C + 139 VMIN=VMIN*BASE**SIGN(1.,VMIN*(VMIN-VMAX)) + VMAX=VMAX*BASE**SIGN(1.,VMAX*(VMAX-VMIN)) + GO TO 112 +C + 140 VMIN=WMIN + VMAX=WMAX +C +C Now we examine the parameters defining the appearance of the numeric +C labels. If the numeric-label type is zero, there is no more to do. +C + 115 IF (QLTD.EQ.SVAL(1).OR.QLTD.EQ.SVAL(2)) GO TO 116 + NLTP=MAX0(0,MIN0(3,NLTD)) + IF (NLTP.EQ.0) GO TO 136 +C +C The numeric-label type (NLTP) is specified. If both the numeric-label +C exponent and numeric-label fraction-length are also specified, quit. +C + NLEX=NLED + NLFL=NLFD + IF (QLED.NE.SVAL(1).AND.QLED.NE.SVAL(2).AND. + + QLFD.NE.SVAL(1).AND.QLFD.NE.SVAL(2) ) GO TO 136 + GO TO 117 +C +C We must pick a value for the numeric-label type. Start with the dummy +C value 4 so as to jump to the proper piece of code. +C + 116 NLTP=4 +C +C Reduce the value of BASE to the form RBSE * 10**KBSE, where RBSE is +C in the range (1,10) and KBSE is an integer. +C + 117 FTMP=BASE + ASSIGN 118 TO JMP1 + GO TO 200 +C + 118 RBSE=FTMP + KBSE=ITMP +C +C Compute LBSE = the number of significant digits in RBSE. +C + ASSIGN 119 TO JMP2 + GO TO 300 +C + 119 LBSE=1+ITMP +C +C Jump depending on the value of the numeric-label type. +C + GO TO (120,128,131,132) , NLTP +C +C Scientific notation is to be used. Estimate the number of significant +C digits that are likely to be required, depending on the number type. +C + 120 GO TO (121,123,124) , NBTP +C + 121 FTMP=AMAX1(ABS(VMIN),ABS(VMAX))/BASE + ASSIGN 122 TO JMP1 + GO TO 200 +C + 122 NSIG=MAX0(1,ITMP+1+LBSE) + GO TO 125 +C + 123 NSIG=LBSE + GO TO 125 +C + 124 NSIG=10 +C +C NLEX + NLFL should be equal to NSIG. Make that the case. +C + 125 IF (QLED.NE.SVAL(1).AND.QLED.NE.SVAL(2)) GO TO 127 + IF (QLFD.EQ.SVAL(1).OR. QLFD.EQ.SVAL(2)) GO TO 126 + NLEX=NSIG-MAX0(0,NLFL) + GO TO 135 + 126 NLEX=1 + 127 NLFL=NSIG-NLEX + IF (NLFL.LE.0) NLFL=-1 + GO TO 135 +C +C Exponential notation is to be used. Compute the exponent NEXP such +C that BASE / 10**NEXP is an integer. +C + 128 NEXP=KBSE-LBSE+1 +C +C NLEX - NLFL should be equal to NEXP. Make that the case. (Note that, +C if NBTP is 3, NLEX is forced to zero.) +C + IF (NBTP.EQ.3) NLEX=0 +C + IF (QLFD.NE.SVAL(1).AND.QLFD.NE.SVAL(2)) GO TO 129 + IF (QLED.NE.SVAL(1).AND.QLED.NE.SVAL(2)) GO TO 130 + NLFL=-1 + 129 NLEX=MAX0(0,NLFL)+NEXP + GO TO 135 + 130 NLFL=NLEX-NEXP + IF (NLFL.LE.0) NLFL=-1 + GO TO 135 +C +C No-exponent notation is to be used. NLFL is the only parameter we +C need to worry about. If it is already set, quit. +C + 131 IF (QLFD.NE.SVAL(1).AND.QLFD.NE.SVAL(2)) GO TO 136 +C +C Set NLFL to the actual number of digits in the fractional portion of +C BASE. +C + NLFL=LBSE-KBSE-1 + IF (NLFL.LE.0) NLFL=-1 + GO TO 135 +C +C We must pick a value for the numeric-label type, depending on the +C number type. +C + 132 GO TO (133,134,134) , NBTP +C +C Nunbers are of the form (-) BASE * EXMU. Use labels with no exponent +C unless the use of an exponent would result in shorter labels. +C + 133 IF (MAX0(KBSE+1-LBSE,-KBSE-1).GT.4) GO TO 134 + NLTP=3 + NLFL=LBSE-KBSE-1 + IF (NLFL.LE.0) NLFL=-1 + GO TO 135 +C +C Exponential notation is used. +C + 134 NLTP=2 + NLEX=KBSE-LBSE+1 + NLFL=-1 +C +C Back-store the computed parameters, if requested, and return. +C + 135 IF (QLTD.EQ.SVAL(2)) QLTD=FLOAT(NLTP) + IF (QLED.EQ.SVAL(2)) QLED=FLOAT(NLEX) + IF (QLFD.EQ.SVAL(2)) QLFD=FLOAT(NLFL) +C +C Pack up integer values to floating-point arguments and return. +C + 136 QMNT=FLOAT(NMNT) + QLTP=FLOAT(NLTP) + QLEX=FLOAT(NLEX) + QLFL=FLOAT(NLFL) + RETURN +C +C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* +C +C This internal procedure reduces the number (FTMP) to the range (1,10), +C returning (FTMP) and (ITMP) such that (FTMP) * 10**(ITMP) is equal to +C the original value of (FTMP). (FTMP) must be positive. +C + 200 FTM1=ALOG10(FTMP+SMRL*FTMP) + IF (FTM1.LT.0.) FTM1=FTM1-1. + ITMP=IFIX(FTM1) + FTMP=AMAX1(1.,FTMP*SNGL(10.D0**(-ITMP))) + GO TO JMP1 , (103,118,122) +C +C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* +C +C This internal procedure counts the number of digits in the fractional +C portion of (FTMP), returning the count as the value of (ITMP). +C + 300 FTM1=AMOD(FTMP+SMRL*FTMP,1.) + FTM2=10.*SMRL*FTMP + ITMP=0 +C + 301 IF (FTM1.LT.FTM2) GO TO 302 + ITMP=ITMP+1 + IF (ITMP.GE.10) GO TO 302 + FTM1=AMOD(10.*FTM1,1.) + FTM2=10.*FTM2 + GO TO 301 +C + 302 GO TO JMP2 , (119) +C +C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* +C +C Error exit. +C +C +NOAO - Comment out FTN write and format statement, SETER is okay. +C + 901 CONTINUE +C 901 WRITE (I1MACH(4),9001) IAXS + CALL SETER ('AGEXAX (CALLED BY AGSTUP) - USER-SYSTEM-TO-LABEL-SYST + +EM MAPPING IS NOT MONOTONIC',1,2) +C +C Formats. +C +C9001 FORMAT ('0PROBLEM WITH AXIS NUMBER',I2, +C + ' (1, 2, 3, AND 4 IMPLY LEFT, RIGHT, BOTTOM, AND TOP)') +C +C -NOAO + END diff --git a/sys/gio/ncarutil/autograph/agexus.f b/sys/gio/ncarutil/autograph/agexus.f new file mode 100644 index 00000000..7d4a274e --- /dev/null +++ b/sys/gio/ncarutil/autograph/agexus.f @@ -0,0 +1,89 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGEXUS (SVAL,ZMIN,ZMAX,ZLOW,ZHGH, + + ZDRA,NVIZ,IIVZ,NEVZ,IIEZ,UMIN,UMAX) +C + DIMENSION SVAL(2),ZDRA(1) +C +C The routine AGEXUS is used by AGSTUP to determine tentative values of +C the user-window edge coordinates. Its arguments are as follows: +C +C -- SVAL is the array of special values. +C +C -- ZMIN and ZMAX are user-supplied minimum and maximum values of the +C data x (or y) coordinates. +C +C -- ZLOW and ZHGH are, respectively, the smallest and largest data +C values to be considered in choosing the minimum and maximum, if +C those values, as given by the user, are null. +C +C -- ZDRA, NVIZ, IIVZ, NEVZ, and IIEZ specify the array of x (or y) +C data coordinates (see AGMAXI or AGMINI for complete description). +C +C -- UMIN and UMAX are returned with tentative minimum and maximum +C values for use at the appropriate user-window edges (left/right +C or bottom/top). +C +C The following common block contains AUTOGRAPH variables which are +C not control parameters. The only one used here is SMRL, which is a +C (machine-dependent) small real which, when added to a number in the +C range (1,10), will round it upward without seriously affecting the +C leading significant digits. The object of this is to get rid of +C strings of nines. +C + COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ , + + INIF +C +C Assume initially that the user has provided actual values to be used. +C + UMIN=ZMIN + UMAX=ZMAX +C +C If either of the values is null, replace it by a data-based value. +C + IF (UMIN.EQ.SVAL(1).OR.UMIN.EQ.SVAL(2)) + + UMIN=AGMINI(SVAL(1),ZLOW,ZDRA,NVIZ,IIVZ,NEVZ,IIEZ) + IF (UMAX.EQ.SVAL(1).OR.UMAX.EQ.SVAL(2)) + + UMAX=AGMAXI(SVAL(1),ZHGH,ZDRA,NVIZ,IIVZ,NEVZ,IIEZ) +C +C Either or both values might still be null (if the user data was null). +C + IF (UMIN.EQ.SVAL(1)) UMIN=UMAX + IF (UMAX.EQ.SVAL(1)) UMAX=UMIN +C +C Check the relative values of UMIN and UMAX for problems. +C + IF (ABS(UMIN-UMAX).LT.50.*SMRL*(ABS(UMIN)+ABS(UMAX))) GO TO 102 + IF (UMAX-UMIN) 101,102,103 + 101 IF (ZMIN.NE.SVAL(1).AND.ZMIN.NE.SVAL(2)) UMAX=UMIN + IF (ZMAX.NE.SVAL(1).AND.ZMAX.NE.SVAL(2)) UMIN=UMAX +C + 102 UMIN=UMIN-.5*ABS(UMIN) + UMAX=UMAX+.5*ABS(UMAX) + IF (UMIN.NE.UMAX) GO TO 103 + UMIN=-1. + UMAX=+1. +C +C If the user wanted these values back-stored, do it. +C + 103 IF (ZMIN.EQ.SVAL(2)) ZMIN=UMIN + IF (ZMAX.EQ.SVAL(2)) ZMAX=UMAX +C +C Done. +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agezsu.f b/sys/gio/ncarutil/autograph/agezsu.f new file mode 100644 index 00000000..535e1811 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agezsu.f @@ -0,0 +1,104 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGEZSU (ITOC,XDRA,YDRA,IDXY,MANY,NPTS,LABG,IIVX,IIEX, + + IIVY,IIEY) +C + REAL XDRA(1),YDRA(1) + CHARACTER*(*) LABG +C +C The routine AGEZSU is used by the AUTOGRAPH routines EZY, EZXY, EZMY, +C EZMXY, and IDIOT to examine those parameters which are peculiar to the +C old version of AUTOGRAPH and to do the appropriate call to AGSTUP. +C The arguments are as follows: +C +C -- ITOC indicates which routine is calling AGEZSU, as follows: +C +C -- ITOC .EQ. 1 - call by EZY +C -- ITOC .EQ. 2 - call by EZXY +C -- ITOC .EQ. 3 - call by EZMY +C -- ITOC .EQ. 4 - call by EZMXY +C -- ITOC .EQ. 5 - call by IDIOT +C +C -- XDRA is an array of x-coordinate data. +C +C -- YDRA is an array of y-coordinate data. +C +C -- IDXY is the first dimension of YDRA. +C +C -- MANY is the number of curves defined by XDRA and YDRA. +C +C -- NPTS is the number of points per curve. +C +C -- LABG is a new header label (or the single character CHAR(0), if the +C header label is to be unchanged). +C +C -- IIVX, IIEX, IIVY, and IIEY are indexing controls for the x and y +C data arrays, computed and returned by AGEZSU for use in setting up +C calls to the routine AGCURV. +C +C Examine the frame-advance parameter. Do frame advance as appropriate. +C + CALL AGGETI ('FRAM.',IFRA) + IFRA=MAX0(1,MIN0(3,IFRA)) +C + IF (IFRA.EQ.3) CALL FRAME +C +C Set up the header label. +C + IF (ICHAR(LABG(1:1)).NE.0) THEN + CALL AGSETC ('LABE/NAME.', 'T') + CALL AGSETI ('LINE/NUMB.', 100) + CALL AGSETC ('LINE/TEXT.',LABG) + END IF +C +C Set up the AGSTUP arguments defining the coordinate-data arrays. +C + CALL AGGETI ('ROW .',IROW) + IROW=MAX0(-2,MIN0(+2,IROW)) +C + NVIY=MANY + IIVY=IDXY + NEVY=NPTS + IIEY=1 +C + IF (IROW.LE.0.AND.ITOC.GE.3.AND.ITOC.LE.4) THEN + IIVY=1 + IIEY=IDXY + END IF +C + NVIX=NVIY + IIVX=IIVY + NEVX=NEVY + IIEX=IIEY +C + IF (IABS(IROW).LE.1) THEN + NVIX=1 + IIVX=0 + NEVX=NPTS + IIEX=1 + END IF +C + IF (ITOC.EQ.1.OR.ITOC.EQ.3) IIEX=0 +C +C Do the AGSTUP call. +C + CALL AGSTUP (XDRA,NVIX,IIVX,NEVX,IIEX,YDRA,NVIY,IIVY,NEVY,IIEY) +C +C Done. +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agfpbn.f b/sys/gio/ncarutil/autograph/agfpbn.f new file mode 100644 index 00000000..f4900b60 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agfpbn.f @@ -0,0 +1,37 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + INTEGER FUNCTION AGFPBN (FPDP) +C +C The value of AGFPBN(FPDP) is a binary dash pattern, obtained from the +C floating-point dash pattern FPDP. On machines having a word length +C greater than 16 bits, AGFPBN(FPDP) = IFIX(FPDP). On machines having +C a word length of 16 bits, this is not true. For example, when FPDP = +C 65535. (2 to the 16th minus 1), the equivalent binary dash pattern +C does not have the value 65535, but the value -1 (assuming integers +C are represented in a ones' complement format). So, the functions +C ISHIFT and IOR must be used to generate the dash pattern. +C + TEMP=FPDP + AGFPBN=0 +C + DO 101 I=1,16 + IF (AMOD(TEMP,2.).GE.1.) AGFPBN=IOR(AGFPBN,ISHIFT(1,I-1)) + TEMP=TEMP/2. + 101 CONTINUE +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agftol.f b/sys/gio/ncarutil/autograph/agftol.f new file mode 100644 index 00000000..b685f913 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agftol.f @@ -0,0 +1,119 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGFTOL (IAXS,IDMA,VINP,VOTP,VLCS,LLUA,UBEG,UDIF,FUNS, + + NBTP,SBSE) +C +C The routine AGFTOL is used by AGAXIS to map a fractional distance +C along the axis to a value in the label coordinate system or vice- +C versa. Its arguments are as follows: +C +C -- IAXS specifies which axis is being drawn. It is passed to the +C routine AGUTOL. See AGAXIS for a complete description of IAXS. +C +C -- IDMA specifies the direction of the mapping - from the fractional +C system to the label system if IDMA .GT. 0 or from the label system +C to the fractional system if IDMA .LT. 0. IDMA also specifies how +C the label-system value is given to or returned by AGFTOL. +C +C -- If ABSV(IDMA) .EQ. 1, an actual value in the label coordinate +C system (VLCS) is given to or returned by AGFTOL. +C +C -- If ABSV(IDMA) .NE. 1, a value of the exponent/multiplier EXMU +C corresponding to VLCS is given to or returned by AGFTOL. +C +C -- VINP is an input value in one coordinate system. +C +C -- VOTP is an output value in the other coordinate system. +C +C -- VLCS is an output value in the label coordinate system, returned +C no matter what the value of IDMA. +C +C -- LLUA, UBGA, and UDFA specify the mapping from the user coordinate +C system to the fractional system and vice-versa. See the routine +C AGAXIS for a complete description of these parameters. +C +C -- FUNS is a function-selector, to be used in calls to AGUTOL. It +C selects the mapping from the user coordinate system to the label +C coordinate system and vice-versa. See the routine AGAXIS for a +C complete description of this parameter. +C +C -- NBTP and SBSE specify the mapping of label-coordinate-system values +C to exponent/multiplier values and vice-versa. See the routine +C AGNUMB for a complete dexcription of these parameters. +C +C Determine desired direction of mapping. +C + IF (IDMA.GT.0) THEN +C +C Map axis fraction VINP to a label-coordinate-system value VLCS. +C + VUCS=UBEG+VINP*UDIF + IF (LLUA.NE.0) VUCS=10.**VUCS + CALL AGUTOL (IAXS,FUNS,1,VUCS,VLCS) +C +C If IDMA .EQ. 1, caller wants VLCS - otherwise, map VLCS to the +C appropriate exponent/multiplier value EXMU - return value in VOTP. +C + IF (IDMA.EQ.1) THEN + VOTP=VLCS + RETURN + END IF +C + GO TO (101,102,103) , NBTP +C + 101 VOTP=VLCS/SBSE + RETURN +C + 102 VOTP=ALOG10(VLCS/SBSE) + RETURN +C + 103 VOTP=ALOG10(ABS(VLCS))/ALOG10(ABS(SBSE)) + RETURN +C + ELSE +C +C If IDMA .EQ. -1, caller has provided VINP .EQ. VLCS, a value in the +C label coordinate system - otherwise, VINP .EQ. EXMU, the exponent/ +C multiplier needed to generate VLCS. +C + IF (IDMA.EQ.(-1)) THEN + VLCS=VINP + GO TO 107 + END IF +C + GO TO (104,105,106) , NBTP +C + 104 VLCS=SBSE*VINP + GO TO 107 +C + 105 VLCS=SBSE*10.**VINP + GO TO 107 +C + 106 VLCS=SIGN(1.,SBSE)*ABS(SBSE)**VINP +C +C Map label-system value VLCS to a user-system value VUCS. +C + 107 CALL AGUTOL (IAXS,FUNS,-1,VLCS,VUCS) +C +C Map user-system value VUCS to an axis fraction VOTP and return. +C + IF (LLUA.NE.0) VUCS=ALOG10(VUCS) + VOTP=(VUCS-UBEG)/UDIF + RETURN +C + END IF +C + END diff --git a/sys/gio/ncarutil/autograph/aggetc.f b/sys/gio/ncarutil/autograph/aggetc.f new file mode 100644 index 00000000..caf9f357 --- /dev/null +++ b/sys/gio/ncarutil/autograph/aggetc.f @@ -0,0 +1,51 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGGETC (TPID,CUSR) +C + CHARACTER*(*) TPID,CUSR +C + DIMENSION FURA(1) +C +C The routine AGGETC is used to get the character strings represented +C by the values of certain individual AUTOGRAPH parameters. TPID is a +C parameter identifier (from the caller). CUSR is a character string +C (returned to the caller). +C +C See what kind of parameter is being gotten. +C + CALL AGCTCS (TPID,ITCS) +C +C If the parameter is not intrinsically of type character, log an error. +C + IF (ITCS.EQ.0) GO TO 901 +C +C Otherwise, get the integer value of the parameter and use that to get +C the desired character string. +C + CALL AGGETP (TPID,FURA,1) + CALL AGGTCH (IFIX(FURA(1)),CUSR,LNCS) +C +C Done. +C + RETURN +C +C Error exit. +C + 901 CALL AGPPID (TPID) + CALL SETER ('AGGETC - PARAMETER TO GET IS NOT INTRINSICALLY OF TYP + +E CHARACTER',2,2) +C + END diff --git a/sys/gio/ncarutil/autograph/aggetf.f b/sys/gio/ncarutil/autograph/aggetf.f new file mode 100644 index 00000000..6391222b --- /dev/null +++ b/sys/gio/ncarutil/autograph/aggetf.f @@ -0,0 +1,28 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGGETF (TPID,FUSR) +C + CHARACTER*(*) TPID + DIMENSION FURA(1) +C +C The routine AGGETF may be used to get the real (floating-point) value +C of any single AUTOGRAPH control parameter. +C + CALL AGGETP (TPID,FURA,1) + FUSR=FURA(1) + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/aggeti.f b/sys/gio/ncarutil/autograph/aggeti.f new file mode 100644 index 00000000..31841826 --- /dev/null +++ b/sys/gio/ncarutil/autograph/aggeti.f @@ -0,0 +1,28 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGGETI (TPID,IUSR) +C + CHARACTER*(*) TPID + DIMENSION FURA(1) +C +C The routine AGGETI may be used to get the integer-equivalent value of +C any single AUTOGRAPH control parameter. +C + CALL AGGETP (TPID,FURA,1) + IUSR=IFIX(FURA(1)) + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/aggetp.f b/sys/gio/ncarutil/autograph/aggetp.f new file mode 100644 index 00000000..ac44085e --- /dev/null +++ b/sys/gio/ncarutil/autograph/aggetp.f @@ -0,0 +1,104 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGGETP (TPID,FURA,LURA) +C + CHARACTER*(*) TPID + DIMENSION FURA(1) +C +C The routine AGGETP returns to the user the AUTOGRAPH parameter(s) +C specified by the parameter identifier TPID. The arguments are as +C follows: +C +C -- TPID is the parameter identifier, a string of keywords separated +C from each other by slashes and followed by a period. +C +C -- FURA is the user array which is to receive the desired parameter(s) +C specified by TPID. +C +C -- LURA is the length of the user array FURA. +C +C The following common block contains the AUTOGRAPH control parameters, +C all of which are real. If it is changed, all of AUTOGRAPH (especially +C the routine AGSCAN) must be examined for possible side effects. +C + COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) , + + XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD , + + XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH , + + YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH , + + QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4), + + BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4), + + QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4), + + QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) , + + QODP,QCDP,WOCD,WODQ,QDSH(26) , + + QDLB,QBIM,FLLB(10,8),QBAN , + + QLLN,TCLN,QNIM,FLLN(6,16),QNAN , + + XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW , + + XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP , + + XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4), + + QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4), + + QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4), + + WNLE(4),QLUA(4) , + + RBOX(6),DBOX(6,4),SBOX(6,4) +C +C The following common block contains other AUTOGRAPH variables, both +C real and integer, which are not control parameters. +C + COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ , + + INIF +C +C Define the array DUMI, which allows access to the parameter list as +C an array. +C + DIMENSION DUMI(1) + EQUIVALENCE (QFRA,DUMI) +C +C If initialization has not yet been done, do it. +C + IF (INIF.EQ.0) THEN + CALL AGINIT + END IF +C +C The routine AGSCAN is called to scan the parameter identifier and to +C return three quantities describing the AUTOGRAPH parameters desired. +C + CALL AGSCAN (TPID,LOPA,NIPA,IIPA) +C +C Determine the number of elements to transfer. +C + NURA=MAX0(1,MIN0(LURA,NIPA)) +C +C Transfer the desired parameters to the user array. +C + IDMI=LOPA-IIPA +C + DO 101 IURA=1,NURA + IDMI=IDMI+IIPA + FURA(IURA)=DUMI(IDMI) + 101 CONTINUE +C +C If the current label name is being gotten, return its identifier. +C + CALL AGSCAN ('LABE/NAME.',LOLN,NILN,IILN) + IF (LOPA.EQ.LOLN.AND.NIPA.EQ.NILN.AND.QBAN.NE.0.) THEN + LBAN=IFIX(QBAN) + FURA(1)=FLLB(1,LBAN) + END IF +C +C Done. +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/aggtch.f b/sys/gio/ncarutil/autograph/aggtch.f new file mode 100644 index 00000000..7591c670 --- /dev/null +++ b/sys/gio/ncarutil/autograph/aggtch.f @@ -0,0 +1,78 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGGTCH (IDCS,CHST,LNCS) +C + CHARACTER*(*) CHST +C +C This routine gets character strings previously stored by the routine +C AGSTCH (which see). It has the following arguments: +C +C -- IDCS is the identifying integer returned by AGSTCH when the string +C was stored. +C +C -- CHST is the character string returned. +C +C -- LNCS is the length of the character string returned in CHST. +C +C The following common blocks contain variables which are required for +C the character-storage-and-retrieval scheme of AUTOGRAPH. +C + COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA +C + COMMON /AGCHR2/ CHRA(2000) +C + CHARACTER*1 CHRA +C +C First, blank-fill the character variable to be returned. +C + CHST=' ' +C +C If the identifier is less than -LNIC, the (one-character) string is +C retrieved from it. +C + IF (IDCS.LT.(-LNIC)) THEN + CHST=CHAR(-IDCS-LNIC-1) + LNCS=1 +C +C If the identifier is between -LNIC and -1, its absolute value is the +C index, in INCH, of the descriptor of the character string stored in +C CHRA. +C + ELSE IF (IDCS.LE.(-1)) THEN + I=-IDCS + J=INCH(1,I)-1 + IF (J.GE.0) THEN + LNCS=MIN0(LEN(CHST),INCH(2,I)) + DO 101 K=1,LNCS + J=J+1 + CHST(K:K)=CHRA(J) + 101 CONTINUE + ELSE + LNCS=0 + END IF +C +C In all other cases, return a single blank. +C + ELSE + LNCS=1 +C + END IF +C +C Done. +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/aginit.f b/sys/gio/ncarutil/autograph/aginit.f new file mode 100644 index 00000000..e863e01f --- /dev/null +++ b/sys/gio/ncarutil/autograph/aginit.f @@ -0,0 +1,113 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGINIT +C +C This routine is called to initialize some machine-dependent constants. +C +C The following common block contains the AUTOGRAPH control parameters, +C all of which are real. If it is changed, all of AUTOGRAPH (especially +C the routine AGSCAN) must be examined for possible side effects. +C + COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) , + + XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD , + + XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH , + + YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH , + + QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4), + + BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4), + + QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4), + + QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) , + + QODP,QCDP,WOCD,WODQ,QDSH(26) , + + QDLB,QBIM,FLLB(10,8),QBAN , + + QLLN,TCLN,QNIM,FLLN(6,16),QNAN , + + XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW , + + XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP , + + XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4), + + QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4), + + QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4), + + WNLE(4),QLUA(4) , + + RBOX(6),DBOX(6,4),SBOX(6,4) +C +C The following common block contains other AUTOGRAPH variables, both +C real and integer, which are not control parameters. +C + COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ , + + INIF +C +C Fill in the names of the four pre-defined labels. +C + CALL AGSTCH ('L',1,IDCS) + FLLB(1,1)=FLOAT(IDCS) + CALL AGSTCH ('R',1,IDCS) + FLLB(1,2)=FLOAT(IDCS) + CALL AGSTCH ('B',1,IDCS) + FLLB(1,3)=FLOAT(IDCS) + CALL AGSTCH ('T',1,IDCS) + FLLB(1,4)=FLOAT(IDCS) +C +C Declare the rest of the label-definition slots to be available. +C + LBIM=IFIX(QBIM) +C + DO 101 J=5,LBIM + FLLB(1,J)=0. + 101 CONTINUE +C +C Fill in the text of the four pre-defined lines. +C + CALL AGSTCH ('Y',1,IDCS) + FLLN(4,1)=FLOAT(IDCS) + CALL AGSTCH (' ',1,IDCS) + FLLN(4,2)=FLOAT(IDCS) + CALL AGSTCH ('X',1,IDCS) + FLLN(4,3)=FLOAT(IDCS) + CALL AGSTCH (' ',1,IDCS) + FLLN(4,4)=FLOAT(IDCS) +C +C Declare the rest of the line-definition slots to be available. +C + LNIM=IFIX(QNIM) +C + DO 102 J=5,LNIM + FLLN(1,J)=SVAL(1) + 102 CONTINUE +C +C Set the value of 'LINE/TERMINATOR.' +C + CALL AGSTCH ('$',1,IDCS) + TCLN=FLOAT(IDCS) +C +C SMRL is used by AUTOGRAPH for rounding operations. +C + SMRL=10.**(3-IFIX(ALOG10(FLOAT(I1MACH(10)))*FLOAT(I1MACH(11)))) +C +C ISLD is an integer containing 16 one bits (right-justified with zero +C fill to the left). It is used to direct the DASHCHAR package to draw +C solid lines. To generate it, we start with a 15-bit mask and then +C add another bit. +C + ISLD = 32767 + ISLD = ISHIFT(ISLD,1) + ISLD = IOR(ISLD,1) +C +C Set the initialization flag to indicate initialization has been done. +C + INIF=1 +C +C Done. +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agkurv.f b/sys/gio/ncarutil/autograph/agkurv.f new file mode 100644 index 00000000..d93f0659 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agkurv.f @@ -0,0 +1,145 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGKURV (XVEC,IIEX,YVEC,IIEY,NEXY,SVAL) +C + DIMENSION XVEC(1),YVEC(1) +C +C AGKURV plots the curve defined by the points ((X(I),Y(I)),I=1,NEXY), +C where +C +C X(I)=XVEC(1+(I-1)*IIEX) (unless IIEX=0, in which case X(I)=I), and +C Y(I)=YVEC(1+(I-1)*IIEY) (unless IIEY=0, in which case Y(I)=I). +C +C If, for some I, X(I)=SVAL or Y(I)=SVAL, curve line segments having +C (X(I),Y(I)) as an endpoint are omitted. +C +C No windowing is performed. +C +C Check first whether the number of curve points is properly specified. +C + IF (NEXY.LE.0) GO TO 901 +C +C Initialization. Pretend that the last point was point number zero. +C Set the indices for the x and y vectors accordingly. Clear the line- +C drawn-to-last-point flag. +C + INDP=0 + INDX=1-IIEX + INDY=1-IIEY + LDLP=0 +C +C Initialization. Retrieve the current curve window, user window, and +C x/y linear/logarithmic flags. +C + CALL GETSET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW,LTYP) +C +C Initialization. Set linear/log flag and linear-window limits for +C x-axis values. +C + IF (LTYP.EQ.1.OR.LTYP.EQ.2) THEN + LLUX=0 + XLLW=XLUW + XRLW=XRUW + ELSE + LLUX=1 + XLLW=ALOG10(XLUW) + XRLW=ALOG10(XRUW) + END IF +C +C Initialization. Set linear/log flag and linear-window limits for +C y-axis values. +C + IF (LTYP.EQ.1.OR.LTYP.EQ.3) THEN + LLUY=0 + YBLW=YBUW + YTLW=YTUW + ELSE + LLUY=1 + YBLW=ALOG10(YBUW) + YTLW=ALOG10(YTUW) + END IF +C +C Initialization. Call SET, if necessary, to define a linear mapping. +C + IF (LTYP.NE.1) + + CALL SET (XLCW,XRCW,YBCW,YTCW,XLLW,XRLW,YBLW,YTLW,1) +C +C Beginning of loop through points. Update indices and determine the +C user-space coordinates of the next point. +C + 101 IF (INDP.EQ.NEXY) GO TO 102 + INDP=INDP+1 +C + INDX=INDX+IIEX + XNXT=XVEC(INDX) + IF (IIEX.EQ.0) XNXT=FLOAT(INDP) + IF (LLUX.NE.0.AND.XNXT.LE.0.) XNXT=SVAL +C + INDY=INDY+IIEY + YNXT=YVEC(INDY) + IF (IIEY.EQ.0) YNXT=FLOAT(INDP) + IF (LLUY.NE.0.AND.YNXT.LE.0.) YNXT=SVAL +C +C Check whether (XNXT,YNXT) is a special-value point. Handle that case. +C + IF (XNXT.EQ.SVAL.OR.YNXT.EQ.SVAL) THEN + IF (LDLP.EQ.0) GO TO 101 + IF (LDLP.EQ.1) CALL VECTD (XLST,YLST) + CALL LASTD + LDLP=0 + GO TO 101 + END IF +C +C If user space is not linear/linear, modify XNXT and YNXT accordingly. +C + IF (LLUX.NE.0) XNXT=ALOG10(XNXT) + IF (LLUY.NE.0) YNXT=ALOG10(YNXT) +C +C Start or continue line. +C + IF (LDLP.EQ.0) THEN + CALL FRSTD (XNXT,YNXT) + XLST=XNXT + YLST=YNXT + ELSE + CALL VECTD (XNXT,YNXT) + END IF +C + LDLP=LDLP+1 + GO TO 101 +C +C Last point was final point. Finish up. +C + 102 IF (LDLP.NE.0) THEN + IF (LDLP.EQ.1) CALL VECTD (XLST,YLST) + CALL LASTD + END IF +C +C Restore logarithmic mapping, if appropriate. +C + IF (LTYP.NE.1) + + CALL SET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW,LTYP) +C +C Return to caller. +C + RETURN +C +C Error exit. +C + 901 CALL SETER ('AGKURV - NUMBER OF POINTS IS LESS THAN OR EQUAL TO ZE + +RO',3,2) +C + END diff --git a/sys/gio/ncarutil/autograph/aglbls.f b/sys/gio/ncarutil/autograph/aglbls.f new file mode 100644 index 00000000..d99b038d --- /dev/null +++ b/sys/gio/ncarutil/autograph/aglbls.f @@ -0,0 +1,616 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGLBLS (ITST,WCWP,HCWP,FLLB,LBIM,FLLN,DBOX,SBOX,RBOX) +C + DIMENSION FLLB(10,8),FLLN(6,16),DBOX(6,4),SBOX(6,4),RBOX(6) +C +C The routine AGLBLS is used (if ITST .LE. 0) to predict the amount of +C space which will be required for graph labels (excluding the numeric +C labels on the axes, which are handled by AGAXIS) or (if ITST .GT. 0) +C to actually draw the graph labels. +C +C The labels in question are defined by the label list (FLLB array) and +C the line list (FLLN array). Each label is assumed to lie in one of +C five boxes, as follows: +C +C Box 1 is to the left of the curve window. +C Box 2 is to the right of the curve window. +C Box 3 is below the curve window. +C Box 4 is above the curve window. +C Box 5 is the curve window itself. +C Box 6 is the entire plot (graph) window. +C +C A test run of AGLBLS returns two sets of box dimensions to the caller. +C DBOX contains the dimensions required if all labels are to have their +C desired sizes, SBOX the dimensions required if all labels are to have +C their smallest sizes. The caller is expected to use this information +C to determine a final set of box dimensions (stored in DBOX), and then +C call AGLBLS again to actually draw the labels in those boxes. +C +C The arguments of AGLBLS are as follows: +C +C -- ITST specifies whether the call is a test call (ITST .LE. 0) or a +C real call (ITST .GT. 0). If ABSV(ITST) .GT. 1, AGLBLS is allowed +C to shrink the labels if they would not otherwise fit in their box. +C If ABSV(ITST) .EQ. 1, shrinkage of labels is prohibited. If ITST +C .EQ. 0, labels are suppressed. +C +C -- WCWP and HCWP are the width and height of the curve window, in +C plotter-coordinate-system units. AGLBLS assumes that the last call +C to the plot package routine "SET" had arguments XLCW, XRCW, YBCW, +C YTCW, 0., 1., 0., 1., and 1 - defining the most convenient system +C of coordinates for it. +C +C -- FLLB is the array in which the label list is stored. The array is +C doubly-dimensioned. The first subscript specifies one of ten label +C attributes, the second a particular label. The attributes are as +C follows (the name ILLB(M,N) refers to a label attribute which is +C intrinsically an integer, despite being stored as a real): +C +C -- ILLB(1,N) specifies the name of label N. If ILLB(1,N) is zero, +C no label is defined. Otherwise, ILLB(1,N) is an identifier +C returned by AGSTCH when the name of the label (a character +C string) was stored away. +C +C -- ILLB(2,N) may be set non-zero to suppress label N. +C +C -- FLLB(3,N) and FLLB(4,N) are the x and y coordinates of a base- +C point relative to which label N is positioned, as fractions of +C the width and height, respectively, of the curve window. The +C position of the base-point determines the box in which label N +C is considered to lie. +C +C -- FLLB(5,N) and FLLB(6,N) are small offsets (typically about the +C size of a character width), stated as fractions of the smaller +C side of the curve window. They are used to offset the label +C base-point (after the box number is determined). Typically, +C this provides a minimum spacing between the label and one side +C of the curve window. +C +C -- ILLB(7,N) is the orientation angle of the label, in degrees +C counter-clockwise from horizontal. The base-line for label N +C is a vector emanating from the base-point at this angle. The +C specified angle must be a multiple of 90 degrees. +C +C -- ILLB(8,N) is the centering option for the label. It specifies +C how each line of the label is to be positioned relative to a +C line perpendicular to the base-line at the base-point. +C +C -- If ILLB(8,N) .LT. 0, the left edge of each line lies on +C the perpendicular. +C +C -- If ILLB(8,N) .EQ. 0, the center of each line lies on the +C perpendicular. +C +C -- If ILLB(8,N) .GT. 0, the right edge of each line lies on +C the perpendicular. +C +C -- ILLB(9,N) is the number of lines in label N. +C +C -- ILLB(10,N) is the second subscript (in the line list) of the +C first line of label N. +C +C -- LBIM is the maximum number of labels the label list will hold. +C +C -- FLLN is the array in which the line list is stored. The array is +C doubly-dimensioned. The first subscript specifies one of six line +C attributes, the second a particular line. The attributes are as +C follows (the name ILLN(M,N) refers to a line attribute which is +C intrinsically an integer, despite being stored as a real): +C +C -- ILLN(1,N) is the position number of line N. The lines of a +C label are ordered according to their position numbers, the one +C having the largest position number being top-most. Moreover, +C lines having position numbers .GT. 0 are placed above the label +C base-line, those having position numbers .EQ. 0 (of which there +C should be but one) are placed on the label base-line, and those +C having position numbers .LT. 0 are placed below the label base- +C line. The magnitudes of the position numbers have nothing to +C do with inter-line spacing - that is up to AGLBLS to determine. +C +C -- ILLN(2,N) may be set non-zero to suppress line N. +C +C -- FLLN(3,N) is the desired width of characters in the line, as a +C fraction of the smaller side of the curve window. +C +C -- ILLN(4,N) is the identifier of the character string comprising +C the text of the line, as returned by AGSTCH at the time the +C string was stored. +C +C -- ILLN(5,N) is the number of characters in the line. +C +C -- ILLN(6,N) is the index of the next line of the label. The +C lines of a label must be ordered by position number (largest +C to smallest). +C +C -- DBOX and SBOX, dimensioned 6 X 4, contain box dimensions, as dis- +C cussed above. D/SBOX(M,N) is the Nth edge-coordinate of box M, +C where N .EQ. 1 for the left edge, 2 for the right edge, 3 for the +C bottom edge, and 4 for the top edge, of the box. The first two are +C stated as fractions of the width, the second two as fractions of +C the height, of the curve window. +C +C RBOX, dimensioned 6, holds reduction factors for the sizes of the +C characters in labels in each of the six boxes. Each RBOX(M) is +C +C -- negative to specify smallest-size characters, or +C +C -- zero to specify that no reduction factor has been chosen, or +C +C -- positive, between 0. and 1. (an actual reduction factor). +C +C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* +C +C The following common block contains other AUTOGRAPH variables, both +C real and integer, which are not control parameters. The only one of +C interest here is MWCL, which is the minimum usable character width, +C in plotter units. +C + COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ , + + INIF +C +C The following common block contains other AUTOGRAPH variables, of type +C character. +C + COMMON /AGOCHP/ CHS1,CHS2 +C +c+noao +c CHARACTER*504 CHS1,CHS2 + CHARACTER*500 CHS1,CHS2 +c-noao +C +C HCFW(WDTH) specifies the height of a character as a function of width. +C + HCFW(WDTH)=2.*WDTH +C +C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* +C +C This is the main section of AGLBLS. +C +C Compute the length of the smallest side of the curve window. +C + SCWP=AMIN1(WCWP,HCWP) +C +C Preset certain jumps in the internal procedure which follows. +C + ASSIGN 211 TO JMP1 + ASSIGN 216 TO JMP2 + ASSIGN 221 TO JMP3 +C +C Jump if this is a test run. +C + IF (ITST.LE.0) GO TO 101 +C +C This is not a test run. If the reduction factors for the six boxes +C are already set, jump directly to the plotting section; otherwise, we +C must first compute the coordinates of the six smallest-size boxes. +C + IF (RBOX(1).NE.0.) GO TO 115 + GO TO 105 +C +C This is a test run. Compute the coordinates of the edges of the six +C desired-size boxes. +C + 101 RWCL=1. + NBOX=0 + ASSIGN 102 TO JMP4 + GO TO 200 +C + 102 DBOX(NBOX,1)=XLBX + DBOX(NBOX,2)=XRBX + DBOX(NBOX,3)=YBBX + DBOX(NBOX,4)=YTBX +C + IF (NBOX.LT.6) GO TO 200 +C +C This is a test run. Compute the coordinates of the edges of the six +C smallest-size boxes, in one of two ways. +C + IF (IABS(ITST).GT.1) GO TO 105 +C +C This is a test run. Determine smallest-size boxes (no shrinking). +C + DO 104 J=1,4 + DO 103 I=1,6 + SBOX(I,J)=DBOX(I,J) + 103 CONTINUE + 104 CONTINUE + RETURN +C +C Determine smallest-size boxes (shrinking allowed). +C + 105 RWCL=0. + NBOX=0 + ASSIGN 106 TO JMP4 + GO TO 200 +C + 106 SBOX(NBOX,1)=XLBX + SBOX(NBOX,2)=XRBX + SBOX(NBOX,3)=YBBX + SBOX(NBOX,4)=YTBX +C + IF (NBOX.LT.6) GO TO 200 +C +C If this is not a test run, jump to compute reduction factors for each +C of the six boxes and then plot the labels. Otherwise, return. +C + IF (ITST.GT.0) GO TO 107 + RETURN +C +C This is not a test run. Compute reduction factors for each of the +C six boxes. +C + 107 NBOX=1 + ASSIGN 110 TO JMP4 +C +C (DBOX(NBOX,I),I=1,4) specifies the box in which the labels are to be +C drawn, (SBOX(NBOX,I),I=1,4) the minimum box in which they can be drawn +C if shrunk. Check first whether the latter is contained in the former. +C If so, we have a chance. If not, the best we can do is shrink the +C labels to minimum size and hope for the best. +C + 108 IF (SBOX(NBOX,1).LT.SBOX(NBOX,2).AND. + + DBOX(NBOX,1)-SBOX(NBOX,1).LT..0001.AND. + + SBOX(NBOX,2)-DBOX(NBOX,2).LT..0001.AND. + + DBOX(NBOX,3)-SBOX(NBOX,3).LT..0001.AND. + + SBOX(NBOX,4)-DBOX(NBOX,4).LT..0001 ) GO TO 109 +C + RBOX(NBOX)=-1. + GO TO 114 +C +C Mimimum-size labels will fit. Find the largest value of RBOX(NBOX) +C for which the labels will fit. +C + 109 RWCL=1. + DWCL=.5 + SWCL=0. + GO TO 201 +C +C See if the last value of RBOX(NBOX) gave us labels which would fit or +C not and adjust the value accordingly. +C + 110 IF (DBOX(NBOX,1)-XLBX.LT..0001.AND. + + XRBX-DBOX(NBOX,2).LT..0001.AND. + + DBOX(NBOX,3)-YBBX.LT..0001.AND. + + YTBX-DBOX(NBOX,4).LT..0001 ) GO TO 111 +C +C Labels did not fit. Adjust RBOX(NBOX) downward. +C + RWCL=RWCL-DWCL + DWCL=.5*DWCL + IF (DWCL.LT..001) RWCL=SWCL + GO TO 201 +C +C Labels did fit. Adjust RBOX(NBOX) upward, unless it is equal to 1. +C + 111 IF (RWCL.EQ.1.) GO TO 113 + SWCL=RWCL + RWCL=RWCL+DWCL + DWCL=.5*DWCL + IF (DWCL.GT..001) GO TO 201 +C +C The current value of RBOX(NBOX) is acceptable. Do next box, if any. +C + 113 IF (NBOX.GE.5) GO TO 114 +C +C Return updated box-edge coordinates for boxes 1 through 4. +C + DBOX(NBOX,1)=XLBX + DBOX(NBOX,2)=XRBX + DBOX(NBOX,3)=YBBX + DBOX(NBOX,4)=YTBX +C + 114 NBOX=NBOX+1 + IF (NBOX.LE.6) GO TO 108 +C +C We have done all we can to make the labels fit. Plot them now. +C + 115 NBOX=0 + LBIN=0 + ASSIGN 117 TO JMP3 + ASSIGN 120 TO JMP4 +C +C Get a label to chew on. +C + 116 ASSIGN 211 TO JMP1 + ASSIGN 216 TO JMP2 + GO TO 202 +C +C We have a label. Initialize the re-loop through the lines in it. +C + 117 XPLN=XPLB-DTLB*YDLB/WCWP + YPLN=YPLB+DTLB*XDLB/HCWP + PHCL=0. + LNIN=LNII + ASSIGN 118 TO JMP1 + ASSIGN 116 TO JMP2 + GO TO 210 +C +C Get ready to plot the label line. +C + 118 XPLN=XPLN+.5*(PHCL+FHCL)*YDLB/WCWP + YPLN=YPLN-.5*(PHCL+FHCL)*XDLB/HCWP + PHCL=FHCL + CALL AGGTCH (IFIX(FLLN(4,LNIN)),CHS2,LNC2) +C +C Give the user a chance to change the appearance of the label line. +C + CALL AGCHIL (0,CHS1(1:LNC1),IFIX(FLLN(1,LNIN))) +C +C Plot the label line. +C + CALL AGPWRT (XPLN,YPLN,CHS2,LNC2,IWCL,LBOR,LBCN) +C +C Give the user a chance to undo the changes he made above. +C + CALL AGCHIL (1,CHS1(1:LNC1),IFIX(FLLN(1,LNIN))) +C +C Go get the next line, if any. +C + GO TO 215 +C +C All labels are drawn. Return. +C + 120 RETURN +C +C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* +C +C This internal procedure, which may be entered and exited in a number +C of different ways, is used to scan the label list and the line list +C and to return information about the labels and lines defined there. +C +C Entry occurs here to bump the box number, store away a reduction +C factor for the sizes of labels in that box, and then compute the edge +C coordinates of the box required to hold labels of the size implied by +C that reduction factor. +C + 200 NBOX=NBOX+1 +C +C Entry occurs here to do all of the above except the bumping of the box +C number. +C + 201 RBOX(NBOX)=RWCL +C +C Initialize the label-list index and the box-edge parameters. +C + LBIN=0 + XLBX=+1000. + XRBX=-1000. + YBBX=+1000. + YTBX=-1000. + IF (ITST.EQ.0) GO TO 222 +C +C This is the beginning of the loop through the labels. Entry occurs +C here to find the next label in the list and return positioning info. +C +C Increment the label index and test for end of label list. +C + 202 LBIN=LBIN+1 + IF (LBIN.GT.LBIM) GO TO 222 +C +C Skip this label if it is non-existent, suppressed, or empty. +C + IF (FLLB(1,LBIN).EQ.0..OR.FLLB(2,LBIN).NE.0. + + .OR.FLLB(9,LBIN).EQ.0.) GO TO 202 +C +C Unpack the parameters specifying the label-base-point position. +C + XBLB=FLLB(3,LBIN) + YBLB=FLLB(4,LBIN) + XOLB=FLLB(5,LBIN) + YOLB=FLLB(6,LBIN) +C +C Determine in which of five boxes the label lies: +C +C in the box to the left of the curve window. +C + LBBX=1 + IF (XBLB.EQ.0..AND.XOLB.LE.0.) GO TO 203 +C +C in the box to the right of the curve window, +C + LBBX=2 + IF (XBLB.EQ.1..AND.XOLB.GE.0.) GO TO 203 +C +C in the box below the curve window, +C + LBBX=3 + IF (YBLB.EQ.0..AND.YOLB.LE.0.) GO TO 203 +C +C in the box above the curve window, +C + LBBX=4 + IF (YBLB.EQ.1..AND.YOLB.GE.0.) GO TO 203 +C +C in the curve window, +C + LBBX=5 + IF ( (XBLB.EQ.0..AND.XOLB.GT.0.).OR. + + (XBLB.EQ.1..AND.XOLB.LT.0.).OR. + + (YBLB.EQ.0..AND.YOLB.GT.0.).OR. + + (YBLB.EQ.1..AND.YOLB.LT.0.) ) GO TO 203 +C +C or elsewhere. +C + LBBX=6 +C +C If we are interested in a particular box and this label is not in that +C box, skip it. +C + 203 IF (NBOX.NE.0.AND.LBBX.NE.NBOX) GO TO 202 +C +C On a non-test run, get the label name and length for call to AGCHIL. +C + IF (ITST.GT.0) CALL AGGTCH (IFIX(FLLB(1,LBIN)),CHS1,LNC1) +C +C Unpack the label orientation and compute its direction cosines. +C + LBOR=IFIX(FLLB(7,LBIN)) +C + XDLB=COS(.017453292519943*FLLB(7,LBIN)) + YDLB=SIN(.017453292519943*FLLB(7,LBIN)) +C +C Unpack the label-centering option. +C + LBCN=IFIX(FLLB(8,LBIN)) +C +C Unpack the index of the initial line of the label and save it. +C + LNIN=IFIX(FLLB(10,LBIN)) + LNII=LNIN +C +C If this is not a test run, modify the label-base-point position as +C needed to move the label into the actual box in which it must fit. +C + IF (ITST.LE.0) GO TO 209 +C + GO TO (204,205,206,207,208,209) , LBBX +C + 204 XBLB=XBLB+DBOX(1,2) + GO TO 209 +C + 205 XBLB=XBLB+DBOX(2,1)-1. + GO TO 209 +C + 206 YBLB=YBLB+DBOX(3,4) + GO TO 209 +C + 207 YBLB=YBLB+DBOX(4,3)-1. + GO TO 209 +C + 208 IF (XBLB.EQ.0.) XBLB=XBLB+DBOX(5,1) + IF (XBLB.EQ.1.) XBLB=XBLB+DBOX(5,2)-1. + IF (YBLB.EQ.0.) YBLB=YBLB+DBOX(5,3) + IF (YBLB.EQ.1.) YBLB=YBLB+DBOX(5,4)-1. +C +C Compute the final label-base-point position. +C + 209 XPLB=XBLB+XOLB*SCWP/WCWP + YPLB=YBLB+YOLB*SCWP/HCWP +C +C Before entering the loop through the line list, initialize the label- +C dimension parameters. +C + DLLB=0. + DRLB=0. + DBLB=0. + DTLB=0. +C +C This is the beginning of the loop through the lines in a given label. +C Entry may occur here to find the next line and return info about it. +C +C If the line is suppressed or of zero length, skip it. +C + 210 IF (FLLN(2,LNIN).NE.0..OR.FLLN(5,LNIN).LE.0.) GO TO 215 +C +C Unpack the position-number, character-width, and character-count +C parameters for the line. +C + LNPN=IFIX(FLLN(1,LNIN)) + WCLN=FLLN(3,LNIN) + LNCC=IFIX(FLLN(5,LNIN)) +C +C Compute the integer width (IWCL) and the floating-point width and +C height (FWCL and FHCL) of characters in the label. All are expressed +C in plotter-coordinate-system units. +C + IWCL=MAX0(MWCL,IFIX(RBOX(LBBX)*WCLN*SCWP+.5)) + FWCL=FLOAT(IWCL) + FHCL=HCFW(FWCL) +C +C Jump back with line information or drop through, as directed. +C + GO TO JMP1 , (118,211) +C +C Update the label-dimension parameters. +C + 211 DRLB=AMAX1(DRLB,FLOAT(LNCC)*FWCL) +C + IF (LNPN) 212,213,214 +C + 212 DBLB=DBLB+FHCL + GO TO 215 +C + 213 DBLB=DBLB+.5*FHCL + DTLB=DTLB+.5*FHCL + GO TO 215 +C + 214 DTLB=DTLB+FHCL +C +C Go to the next line in the label, if there is one. +C + 215 LNIN=IFIX(FLLN(6,LNIN)) + IF (LNIN.NE.0) GO TO 210 +C +C Jump back on end of lines or drop through, as directed. +C + GO TO JMP2 , (116,216) +C +C If all the lines in the label were either suppressed or of zero +C length, skip this label. +C + 216 IF (DRLB.EQ.0.) GO TO 202 +C +C Complete the computation of the label dimensions. The four parameters +C DLLB, DRLB, DBLB, and DTLB represent the distances from the base-point +C to the left edge, right edge, bottom edge, and top edge of the label, +C in plotter-coordinate-system units, where left, right, etc., are as +C viewed by a reader of the label. +C + IF (LBCN) 217,218,219 +C +C Left edges of lines are aligned. +C + 217 GO TO 220 +C +C Centers of lines are aligned. +C + 218 DLLB=.5*(DLLB+DRLB) + DRLB=DLLB + GO TO 220 +C +C Right edges of lines are aligned. +C + 219 SWAP=DLLB + DLLB=DRLB + DRLB=SWAP +C +C Jump back with label information or drop through, as directed. +C + 220 GO TO JMP3 , (117,221) +C +C Update the x and y coordinates of the label box edges. +C + 221 XLBX=AMIN1(XLBX,XBLB, + + XPLB-AMAX1(+DLLB*XDLB,-DRLB*XDLB,-DBLB*YDLB,+DTLB*YDLB)/WCWP) + XRBX=AMAX1(XRBX,XBLB, + + XPLB+AMAX1(-DLLB*XDLB,+DRLB*XDLB,+DBLB*YDLB,-DTLB*YDLB)/WCWP) + YBBX=AMIN1(YBBX,YBLB, + + YPLB-AMAX1(+DLLB*YDLB,-DRLB*YDLB,+DBLB*XDLB,-DTLB*XDLB)/HCWP) + YTBX=AMAX1(YTBX,YBLB, + + YPLB+AMAX1(-DLLB*YDLB,+DRLB*YDLB,-DBLB*XDLB,+DTLB*XDLB)/HCWP) +C +C Go back for the next label. +C + GO TO 202 +C +C End of label list. Jump as directed. +C + 222 GO TO JMP4 , (102,106,110,120) +C +C *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* +C + END diff --git a/sys/gio/ncarutil/autograph/agmaxi.f b/sys/gio/ncarutil/autograph/agmaxi.f new file mode 100644 index 00000000..9c981e0d --- /dev/null +++ b/sys/gio/ncarutil/autograph/agmaxi.f @@ -0,0 +1,60 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + FUNCTION AGMAXI (SVAL,ZHGH,ZDRA,NVIZ,IIVZ,NEVZ,IIEZ) +C + DIMENSION ZDRA(1) +C +C The routine AGMAXI returns the maximum value of the elements in ZDRA +C specified by NVIZ, IIVZ, NEVZ, and IIEZ, skipping elements having the +C special value SVAL (or more than ZHGH, if ZHGH is not equal to SVAL). +C +C -- NVIZ is the number of vectors of data stored in ZDRA. +C +C -- IIVZ is the index increment from one data vector to the next. +C +C -- NEVZ is the number of elements per vector to be examined. +C +C -- IIEZ is the index increment from one vector element to the next. +C If IIEZ is 0, the array is ignored and NEVZ is returned. +C + AGMAXI=FLOAT(NEVZ) + IF (IIEZ.EQ.0) RETURN +C + AGMAXI=SVAL + INDZ=1-IIEZ +C + DO 103 I=1,NVIZ + IF (ZHGH.EQ.SVAL) THEN + DO 101 J=1,NEVZ + INDZ=INDZ+IIEZ + IF (ZDRA(INDZ).EQ.SVAL) GO TO 101 + IF (AGMAXI.EQ.SVAL) AGMAXI=ZDRA(INDZ) + AGMAXI=AMAX1(AGMAXI,ZDRA(INDZ)) + 101 CONTINUE + ELSE + DO 102 J=1,NEVZ + INDZ=INDZ+IIEZ + IF (ZDRA(INDZ).EQ.SVAL.OR.ZDRA(INDZ).GT.ZHGH) GO TO 102 + IF (AGMAXI.EQ.SVAL) AGMAXI=ZDRA(INDZ) + AGMAXI=AMAX1(AGMAXI,ZDRA(INDZ)) + 102 CONTINUE + END IF + INDZ=INDZ-NEVZ*IIEZ+IIVZ + 103 CONTINUE +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agmini.f b/sys/gio/ncarutil/autograph/agmini.f new file mode 100644 index 00000000..be4b6d2c --- /dev/null +++ b/sys/gio/ncarutil/autograph/agmini.f @@ -0,0 +1,60 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + FUNCTION AGMINI (SVAL,ZLOW,ZDRA,NVIZ,IIVZ,NEVZ,IIEZ) +C + DIMENSION ZDRA(1) +C +C The routine AGMINI returns the mimimum value of the elements in ZDRA +C specified by NVIZ, IIVZ, NEVZ, and IIEZ, skipping elements having the +C special value SVAL (or less than ZLOW, if ZLOW is not equal to SVAL). +C +C -- NVIZ is the number of vectors of data stored in ZDRA. +C +C -- IIVZ is the index increment from one data vector to the next. +C +C -- NEVZ is the number of elements per vector to be examined. +C +C -- IIEZ is the index increment from one vector element to the next. +C If IIEZ is 0, the array is ignored and 1. is returned. +C + AGMINI=1. + IF (IIEZ.EQ.0) RETURN +C + AGMINI=SVAL + INDZ=1-IIEZ +C + DO 103 I=1,NVIZ + IF (ZLOW.EQ.SVAL) THEN + DO 101 J=1,NEVZ + INDZ=INDZ+IIEZ + IF (ZDRA(INDZ).EQ.SVAL) GO TO 101 + IF (AGMINI.EQ.SVAL) AGMINI=ZDRA(INDZ) + AGMINI=AMIN1(AGMINI,ZDRA(INDZ)) + 101 CONTINUE + ELSE + DO 102 J=1,NEVZ + INDZ=INDZ+IIEZ + IF (ZDRA(INDZ).EQ.SVAL.OR.ZDRA(INDZ).LT.ZLOW) GO TO 102 + IF (AGMINI.EQ.SVAL) AGMINI=ZDRA(INDZ) + AGMINI=AMIN1(AGMINI,ZDRA(INDZ)) + 102 CONTINUE + END IF + INDZ=INDZ-NEVZ*IIEZ+IIVZ + 103 CONTINUE +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agnumb.f b/sys/gio/ncarutil/autograph/agnumb.f new file mode 100644 index 00000000..24469772 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agnumb.f @@ -0,0 +1,491 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGNUMB (NBTP,SBSE,EXMU , NLTP,NLEX,NLFL , + + BFRM,MCIM,NCIM,IPXM , BFRE,MCIE,NCIE) +C + CHARACTER*(*) BFRM,BFRE +C +C The routine AGNUMB converts the number specified by the arguments +C NBTP, SBSE, and EXMU to the label format specified by the arguments +C NLTP, NLEX, and NLFL, returning the characters of the mantissa in the +C buffer BFRM and the characters of the exponent in the buffer BFRE, +C ready for plotting. The arguments of AGNUMB are as follows: +C +C -- NBTP is an integer specifying the type of number to be converted. +C There are three possibilities: +C +C NBTP = 1 - number of the form SBSE * EXMU. +C +C NBTP = 2 - number of the form SBSE * 10**EXMU. +C +C NBTP = 3 - number of the form SIGN(SBSE) * ABSV(SBSE)**EXMU. +C +C -- SBSE is a base value for a set of labels. See NBTP description. +C +C -- EXMU is an exponent or a multiplier for a given label. Although it +C is a floating-point number, its value should be integral, unless +C NBTP equals 1 and/or NLTP equals 1. Using a non-integral EXMU in +C other cases will have undesirable effects. See NBTP description. +C +C -- NLTP is an integer specifying the type of label to be generated. +C There are three possibilities: +C +C -- NLTP = 1 - label is to have an exponent portion and is to be +C expressed in scientific notation. +C +C -- NLTP = 2 - label is to have an exponent portion and is to be +C expressed in a form determined by the number type NBTP. +C +C -- NLTP = 3 - label is to have no exponent portion and is to be +C expressed in a form determined by the number type NBTP. +C +C The possible label types will be described in greater detail below. +C +C -- NLEX (when used) is an integer specifying (in a manner depending on +C the values of other parameters) the value of the exponent portion +C of the label. See the detailed discussion of label types, below. +C +C -- NLFL (when used) is an integer specifying (in a manner depending on +C the values of other parameters) the length of the fractional por- +C tion of the mantissa of the label. See the detailed discussion of +C label types, below. +C +C -- BFRM is a character variable in which the mantissa portion of the +C label is to be returned. +C +C -- MCIM specifies the maximum number of characters BFRM can hold. +C +C -- NCIM is the number of characters returned in BFRM by AGNUMB. +C +C -- IPXM is the position of the character X in the mantissa. If IPXM +C is zero, the character X does not occur in the mantissa. +C +C -- BFRE, MCIE, and NCIE are analogous to BFRM, MCIM, and NCIM, but +C pertain to the exponent portion of the label. +C +C Label types: AGNUMB will produce many different types of labels, as +C directed by the various input parameters. Each of these is described +C below. The general form of a label is +C +C (-) (1/) (I) (.) (F) (X 10) (E) +C +C where the parentheses are used to mark portions which may either be +C present or absent. The minus sign is included only if the label value +C is negative. I is the integer portion of the mantissa, included only +C if its value is non-zero. The decimal point is included if the input +C parameter NLFL does not specifically direct that it should be omitted +C or if the fractional portion of the mantissa (F) is present. F is the +C fractional portion of the mantissa. The "X 10" is included if it is +C appropriate, and is considered to be a part of the mantissa; if it is +C included, a blank is actually returned for the character X, so the +C routine which plots the label should construct this character by +C drawing two short lines. E is the exponent, returned in a separate +C buffer so that it may be plotted in a superscript form. The possible +C label types are, then, as follows: +C +C -- Scientific notation - if the label type NLTP equals 1, the form +C +C (-) (I) (.) (F) X 10 (E) +C +C is used. NLEX specifies the length of I (thus also specifying the +C value of the exponent E). If NLEX is .LE. 0, I is omitted. If +C NLEX is .LT. 0 and has the absolute value N, the fraction F is +C forced to have N leading zeroes. NLFL specifies the length of F. +C If NLFL is .LE. 0, F is omitted. If NLFL is .LT. 0, the decimal +C point is omitted. If (I.F) has the value 1, (I.F X) is omitted. +C If the entire label has zero value, the character 0 is used. +C +C -- Exponential, but non-scientific notation - if the label type NLTP +C equals 2, the form used depends on the argument NBTP, as follows: +C +C -- If NBTP equals 1 (number of the form SBSE * EXMU), the form +C +C (-) (I) (.) (F) X 10 (E) +C +C is used. NLEX specifies the value of the exponent E. The +C length of F is specified by NLFL. If NLFL is .LE. 0, F is +C omitted. If NLFL is .LT. 0, the decimal point is omitted. If +C the label value is exactly 0, the character 0 is used. +C +C -- If NBTP equals 2 (number of the form SBSE*10**EXMU), the form +C +C (-) (I) (.) (F) X 10 (E) +C +C is used. The exponent E has the value NLEX+EXMU. The length +C of F is specified by NLFL. If NLFL is .LE. 0, F is omitted. +C If NLFL is .LT. 0, the decimal point is omitted. If the label +C value is exactly 0, the character 0 is used. If (I.F) has the +C value 1., then (I.F X) is omitted. +C +C -- If NBTP equals 3, specifying that the number is of the form +C SIGN(SBSE) * ABSV(SBSE)**EXMU, the form +C +C (-) (I) (.) (F) (E) +C +C is used. The exponent E has the value EXMU. The length of F +C is specified by NLFL. If NLFL is .LE. 0, F is omitted. If +C NLFL is .LT. 0, the decimal point is omitted. +C +C -- No-exponent notation - if the label type NLTP equals 3, the form +C used depends on the argument NBTP, as follows: +C +C -- If NBTP equals 1 (number of the form SBSE * EXMU), the form +C +C (-) (I) (.) (F) +C +C is used. NLFL specifies the length of F. If NLFL is .LE. 0, +C F is omitted. If NLFL is .LT. 0, the decimal point is omitted. +C If the entire label has zero value, the character 0 is used. +C +C -- If NBTP equals 2 (number of the form SBSE*10**EXMU), the form +C +C (-) (I) (.) (F) +C +C is used. The length of F is specified by the function +C +C MAX(NLFL,0)-EXMU (if EXMU is .LT. MAX(NLFL,0)) +C MIN(NLFL,0) (if EXMU is .GE. MAX(NLFL,0)) +C +C which may appear somewhat formidable, but produces a simple, +C desirable result. Suppose, for example, that SBSE = 3.6, +C NLFL = 1, and EXMU ranges from -3 to +3 - the labels produced +C are as follows: +C +C .0036 .036 .36 3.6 36. 360. 3600. +C +C NLFL may be viewed as specifying the length of F if EXMU is 0. +C If the value of the function is .LE. 0, F is omitted - if its +C value is .LT. 0, the decimal point is omitted. +C +C -- If NBTP equals 3, specifying that the number is of the form +C SIGN(SBSE) * ABSV(SBSE)**EXMU, the form +C +C (-) (I) (.) (F) +C +C is used if EXMU is positive (or zero), and the form +C +C (-) 1 / (I) (.) (F) +C +C is used if EXMU is negative. The length of F is specified by +C the function +C +C NLFL * ABSV(EXMU) (if EXMU is .NE. 0) +C MIN(NLFL,0) (if EXMU is .EQ. 0) +C +C Again, this function produces a simple result. Suppose that +C SBSE = 1.1, NLFL = 1, and EXMU ranges from -3 to +3 - the +C labels produced are as follows: +C +C 1/1.331 1/1.21 1/1.1 1. 1.1 1.21 1.331 +C +C NLFL may be viewed as specifying the length of F if EXMU is 1. +C If the value of the function is .LE. 0, F is omitted - if its +C value is .LT. 0, the decimal point is omitted. As another +C example, suppose that SBSE = 2., NLFL = -1, and EXMU ranges +C from -4 to +4. The labels produced are as follows: +C +C 1/16 1/8 1/4 1/2 1 2 4 8 16 +C +C The following common block contains AUTOGRAPH variables which are +C not control parameters. The only one used here is SMRL, which is a +C (machine-dependent) small real which, when added to a number in the +C range (1,10), will round it upward without seriously affecting the +C leading significant digits. The object of this is to get rid of +C strings of nines. +C + COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ , + + INIF +C +C KHAR holds single characters to be stored away in BFRM or BFRE. +C + CHARACTER*1 KHAR +C +C Zero character counters and pointers. +C + NCIM=0 + NCIE=0 + IPXM=0 +C +C Compute a jump parameter to allow a quick sorting-out of the possible +C number-type/label-type combinations below. +C + NTLT=NBTP+3*(NLTP-1) +C +C Compute the value (XMAN) from which the characters of the mantissa +C will be generated. +C + GO TO (101,102,103,101,102,104,101,102,105) , NTLT +C + 101 XMAN=SBSE*EXMU + GO TO 106 +C + 102 XMAN=SBSE*SNGL(10.D0**DBLE(EXMU)) + GO TO 106 +C + 103 XMAN=SIGN(1.,SBSE)*SNGL(DBLE(ABS(SBSE))**DBLE(EXMU)) + GO TO 106 +C + 104 XMAN=SBSE + GO TO 106 +C + 105 XMAN=SIGN(1.,SBSE)*SNGL(DBLE(ABS(SBSE))**DBLE(ABS(EXMU))) +C +C If the mantissa-generator is negative, make it positive and put a +C minus sign in the mantissa buffer. +C + 106 IF (XMAN.LT.0.) THEN + NCIM=NCIM+1 + IF (NCIM.GT.MCIM) GO TO 901 + BFRM(NCIM:NCIM)='-' + XMAN=-XMAN + END IF +C +C If the number is zero, put a zero in the mantissa buffer and quit. +C + IF (XMAN.EQ.0.) THEN + NCIM=NCIM+1 + IF (NCIM.GT.MCIM) GO TO 901 + BFRM(NCIM:NCIM)='0' + RETURN + END IF +C +C Reduce the mantissa-generator to the range (1.,10.), keeping track of +C the power of 10 required to do it. Round the result, keeping in mind +C that the rounding may kick the value past 10. . +C + IMAN=IFIX(ALOG10(XMAN)) + IF (XMAN.LT.1.) IMAN=IMAN-1 + XMAN=XMAN*SNGL(10.D0**(-IMAN))+SMRL + IF (XMAN.GE.10.) THEN + XMAN=XMAN/10. + IMAN=IMAN+1 + END IF +C +C Jump (depending on the number-type/label-type combination) to set up +C the label-generation control parameters, as follows: +C +C NDPD - number of digits to precede decimal point - if NDPD .LT. 0, +C ABS(NDPD) leading zeroes follow the decimal point, preceding +C the first digit generated from XMAN. +C NDFD - number of digits to follow decimal point - if NDFD .LT. 0, +C the decimal point is suppressed. +C IF10 - flag, set non-zero to force generation of the (X 10) portion +C of the label. +C IFEX - flag, set non-zero to force generation of an exponent. +C IVEX - value of exponent (if any) - always equals (IMAN+1) - NDPD. +C + GO TO (107,107,107,108,109,110,111,112,113) , NTLT +C +C Scientific notation. +C + 107 NDPD=NLEX + NDFD=NLFL + IF10=1 + IFEX=1 + GO TO 114 +C +C Non-scientific exponential notation for SBSE * EXMU. +C + 108 NDPD=IMAN+1-NLEX + NDFD=NLFL + IF10=1 + IFEX=1 + GO TO 114 +C +C Non-scientific exponential notation for SBSE * 10**EXMU. +C + 109 NDPD=IMAN+1-(NLEX+IFIX(EXMU+SMRL*EXMU)) + NDFD=NLFL + IF10=1 + IFEX=1 + GO TO 114 +C +C Non-scientific exponential notation for SIGN(SBSE) * ABSV(SBSE)**EXMU. +C + 110 NDPD=IMAN+1 + IMAN=IMAN+IFIX(EXMU+SMRL*EXMU) + NDFD=NLFL + IF10=0 + IFEX=1 + GO TO 115 +C +C No-exponent notation for SBSE * EXMU. +C + 111 NDPD=IMAN+1 + NDFD=NLFL + IF10=0 + IFEX=0 + GO TO 115 +C +C No-exponent notation for SBSE * 10**EXMU. +C + 112 NDPD=IMAN+1 + NDFD=MAX0(NLFL,0)-IFIX(EXMU+SMRL*EXMU) + IF (NDFD.LE.0) NDFD=MIN0(NLFL,0) + IF10=0 + IFEX=0 + GO TO 115 +C +C No-exponent notation for SIGN(SBSE) * ABSV(SBSE)**EXMU +C + 113 IF (EXMU.LT.0.) THEN + NCIM=NCIM+1 + IF (NCIM.GT.MCIM) GO TO 901 + BFRM(NCIM:NCIM)='1' + NCIM=NCIM+1 + IF (NCIM.GT.MCIM) GO TO 901 + BFRM(NCIM:NCIM)='/' + END IF +C + NDPD=IMAN+1 + NDFD=NLFL*IFIX(ABS(EXMU+SMRL*EXMU)) + IF (NDFD.EQ.0) NDFD=MIN0(NLFL,0) + IF10=0 + IFEX=0 + GO TO 115 +C +C If there is an exponent of 10 and the mantissa is precisely 1, omit +C the (I.F X) portion of the mantissa. +C + 114 IF (NDPD.NE.1) GO TO 115 + IF (IFIX(XMAN).NE.1) GO TO 115 + IF (((XMAN-1.)*10.**MAX0(0,NDFD)).GE.1.) GO TO 115 + IVEX=IMAN+1-NDPD + GO TO 123 +C +C Generate the characters of the mantissa (I.F). Check first for zero- +C or-negative-length error. +C + 115 LMAN=MAX0(NDPD,0)+1+MAX0(NDFD,-1) + IF (LMAN.LE.0) GO TO 903 +C +C Make sure the mantissa buffer is big enough to hold (I.F). +C + IF (NCIM+LMAN.GT.MCIM) GO TO 901 +C +C Compute the value of the parameter IVEX before changing NDPD. +C + IVEX=IMAN+1-NDPD +C +C Generate the digits preceding the decimal point, if any. +C + IF (NDPD.LE.0) GO TO 117 +C + ASSIGN 116 TO JUMP + GO TO 121 +C + 116 NDPD=NDPD-1 + IF (NDPD.NE.0) GO TO 121 +C +C Generate the decimal point. +C + 117 KHAR='.' + ASSIGN 118 TO JUMP + GO TO 122 +C +C Generate leading zeroes, if any, after the decimal point. +C + 118 IF (NDPD.EQ.0) GO TO 120 + KHAR='0' + ASSIGN 119 TO JUMP + GO TO 122 +C + 119 NDPD=NDPD+1 + IF (NDPD.NE.0) GO TO 122 +C +C Generate remaining fractional digits. +C + 120 ASSIGN 121 TO JUMP +C +C Generate a digit from the mantissa-generator. It is assumed that, for +C n between 1 and 9, ICHAR('n') = ICHAR('n-1') + 1 . +C + 121 IDGT=IFIX(XMAN) + KHAR=CHAR(ICHAR('0')+IDGT) + XMAN=XMAN-FLOAT(IDGT) + XMAN=XMAN*10. +C +C Store a digit from KHAR into the mantissa buffer. +C + 122 NCIM=NCIM+1 + BFRM(NCIM:NCIM)=KHAR +C +C Check whether (I.F) is complete. +C + LMAN=LMAN-1 + IF (LMAN.NE.0) GO TO JUMP , (116,118,119,121) +C +C If appropriate, leave space in the mantissa buffer for the "X" . +C + IF (IF10.EQ.0) GO TO 124 + NCIM=NCIM+1 + IF (NCIM.GT.MCIM) GO TO 901 + IPXM=NCIM + BFRM(IPXM:IPXM)=' ' +C +C If appropriate, put a "10" in the mantissa buffer. +C + 123 NCIM=NCIM+1 + IF (NCIM.GT.MCIM) GO TO 901 + BFRM(NCIM:NCIM)='1' + NCIM=NCIM+1 + IF (NCIM.GT.MCIM) GO TO 901 + BFRM(NCIM:NCIM)='0' +C +C If appropriate, generate an exponent in the exponent buffer. +C + 124 IF (IFEX.EQ.0) RETURN +C + IF (IVEX) 126,125,127 +C + 125 NCIE=NCIE+1 + IF (NCIE.GT.MCIE) GO TO 902 + BFRE(NCIE:NCIE)='0' + RETURN +C + 126 NCIE=NCIE+1 + IF (NCIE.GT.MCIE) GO TO 902 + BFRE(NCIE:NCIE)='-' + IVEX=-IVEX +C + 127 NCIE=NCIE+1 + IF (IVEX.GE.10) NCIE=NCIE+1 + IF (IVEX.GE.100) NCIE=NCIE+1 + IF (IVEX.GE.1000) NCIE=NCIE+1 + IF (NCIE.GT.MCIE) GO TO 902 +C + DO 128 I=1,4 + J=NCIE+1-I + BFRE(J:J)=CHAR(ICHAR('0')+MOD(IVEX,10)) + IVEX=IVEX/10 + IF (IVEX.EQ.0) RETURN + 128 CONTINUE +C + IF (IVEX.NE.0) GO TO 902 +C +C Done. +C + RETURN +C +C Error exits. +C + 901 CALL SETER ('AGNUMB - MANTISSA TOO LONG',4,2) +C + 902 CALL SETER ('AGNUMB - EXPONENT TOO LARGE',5,2) +C + 903 CALL SETER ('AGNUMB - ZERO-LENGTH MANTISSA',6,2) +C + END diff --git a/sys/gio/ncarutil/autograph/agppid.f b/sys/gio/ncarutil/autograph/agppid.f new file mode 100644 index 00000000..145d98d3 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agppid.f @@ -0,0 +1,65 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGPPID (TPID) +C + CHARACTER*(*) TPID +C +C The object of this routine is to print out a parameter identifier +C which has caused some kind of problem. +C +C Define a character variable to hold the print line. +C + CHARACTER*124 TEMP +C +C +NOAO + integer*2 itemp(124) +C -NOAO +C +C Set up the print line. +C + TEMP='0PARAMETER IDENTIFIER - ' +C +C Transfer characters of the parameter identifier, one at a time, until +C 100 have been transferred or a period is encountered, whichever occurs +C first. This is done so as to allow for old programs on the Cray which +C used Hollerith strings as parameter identifiers. +C + I=24 +C + DO 101 J=1,100 + I=I+1 + TEMP(I:I)=TPID(J:J) + IF (TEMP(I:I).EQ.'.') GO TO 102 + 101 CONTINUE +C +C Print the line. +C +C +NOAO - replace FTN write and format statement. +C 102 WRITE (I1MACH(4),1001) TEMP + 102 CONTINUE + call f77upk (temp, itemp, 125) + call pstr (itemp) +C +C Done. +C + RETURN +C +C Format. +C +C1001 FORMAT (A124) +C -NOAO +C + END diff --git a/sys/gio/ncarutil/autograph/agpwrt.f b/sys/gio/ncarutil/autograph/agpwrt.f new file mode 100644 index 00000000..25cc2e52 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agpwrt.f @@ -0,0 +1,31 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGPWRT (XPOS,YPOS,CHRS,NCHS,ISIZ,IORI,ICEN) +C + CHARACTER*(*) CHRS +C +C This routine just passes its arguments along to the character-drawing +C routine PWRIT, in the system plot package. By substituting his/her +C own version of AGPWRT, the user can cause a fancier character-drawer +C to be used. +C + CALL PWRIT (XPOS,YPOS,CHRS,NCHS,ISIZ,IORI,ICEN) +C +C Done. +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agqurv.f b/sys/gio/ncarutil/autograph/agqurv.f new file mode 100644 index 00000000..dc70fc43 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agqurv.f @@ -0,0 +1,322 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGQURV (XVEC,IIEX,YVEC,IIEY,NEXY,SVAL) +C + DIMENSION XVEC(1),YVEC(1) +C +C AGQURV plots the curve defined by the points ((X(I),Y(I)),I=1,NEXY), +C where +C +C X(I)=XVEC(1+(I-1)*IIEX) (unless IIEX=0, in which case X(I)=I), and +C Y(I)=YVEC(1+(I-1)*IIEY) (unless IIEY=0, in which case Y(I)=I). +C +C If, for some I, X(I)=SVAL or Y(I)=SVAL, curve line segments having +C (X(I),Y(I)) as an endpoint are omitted. +C +C The curve drawn is windowed. Portions of the curve which would fall +C outside the current curve window, as defined by the last SET call, +C are not drawn. +C +C Check first whether the number of curve points is properly specified. +C + IF (NEXY.LE.0) GO TO 901 +C +C Initialization. Pretend that the last point was point number zero. +C Set the indices for the x and y vectors accordingly. Clear the line- +C drawn-to-last-point and last-point-outside-window flags. +C + INDP=0 + INDX=1-IIEX + INDY=1-IIEY + LDLP=0 + LPOW=0 +C +C Initialization. Retrieve the current curve window, user window, and +C x/y linear/logarithmic flags. +C + CALL GETSET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW,LTYP) +C +C Initialization. Set linear/log flag and linear-window limits for +C x-axis values. +C + IF (LTYP.EQ.1.OR.LTYP.EQ.2) THEN + LLUX=0 + XLLW=XLUW + XRLW=XRUW + ELSE + LLUX=1 + XLLW=ALOG10(XLUW) + XRLW=ALOG10(XRUW) + END IF +C +C Initialization. Set linear/log flag and linear-window limits for +C y-axis values. +C + IF (LTYP.EQ.1.OR.LTYP.EQ.3) THEN + LLUY=0 + YBLW=YBUW + YTLW=YTUW + ELSE + LLUY=1 + YBLW=ALOG10(YBUW) + YTLW=ALOG10(YTUW) + END IF +C +C Initialization. Call SET, if necessary, to define a linear mapping. +C (This greatly simplifies the windowing code.) +C + IF (LTYP.NE.1) + + CALL SET (XLCW,XRCW,YBCW,YTCW,XLLW,XRLW,YBLW,YTLW,1) +C +C Initialization. Compute mimimum and maximum values of x which are +C slightly outside the linear window. (Note: XLLW and XRLW will not +C be used after this.) +C + IF (XLLW.GT.XRLW) THEN + TEMP=XLLW + XLLW=XRLW + XRLW=TEMP + END IF + XEPS=.000001*(XRLW-XLLW) + XMIN=XLLW-XEPS + XMAX=XRLW+XEPS +C +C Initialization. Compute minimum and maximum values of y which are +C slightly outside the linear window. (Note: YBLW and YTLW will not +C be used after this.) +C + IF (YBLW.GT.YTLW) THEN + TEMP=YBLW + YBLW=YTLW + YTLW=TEMP + END IF + YEPS=.000001*(YTLW-YBLW) + YMIN=YBLW-YEPS + YMAX=YTLW+YEPS +C +C Beginning of loop through points. Update indices and determine the +C user-space coordinates of the next point. +C + 101 IF (INDP.EQ.NEXY) GO TO 120 + INDP=INDP+1 +C + INDX=INDX+IIEX + XNXT=XVEC(INDX) + IF (IIEX.EQ.0) XNXT=FLOAT(INDP) + IF (LLUX.NE.0.AND.XNXT.LE.0.) XNXT=SVAL +C + INDY=INDY+IIEY + YNXT=YVEC(INDY) + IF (IIEY.EQ.0) YNXT=FLOAT(INDP) + IF (LLUY.NE.0.AND.YNXT.LE.0.) YNXT=SVAL +C +C Check whether (XNXT,YNXT) is a special-value point. Handle that case. +C + IF (XNXT.EQ.SVAL.OR.YNXT.EQ.SVAL) THEN + LPOW=0 + IF (LDLP.EQ.0) GO TO 101 + IF (LDLP.EQ.1) CALL VECTD (XLST,YLST) + CALL LASTD + LDLP=0 + GO TO 101 + END IF +C +C If user space is not linear/linear, modify XNXT and YNXT accordingly. +C + IF (LLUX.NE.0) XNXT=ALOG10(XNXT) + IF (LLUY.NE.0) YNXT=ALOG10(YNXT) +C +C Set the next-point-outside-window flag to a value between -4 and +4, +C inclusive. A non-zero value indicates that the next point is outside +C the window and indicates which of eight possible areas it falls in. +C + NPOW=IFIX(3.*(SIGN(.51,XNXT-XMIN)+SIGN(.51,XNXT-XMAX))+ + + (SIGN(.51,YNXT-YMIN)+SIGN(.51,YNXT-YMAX))) +C +C There are now various possible cases, depending on whether the line- +C drawn-to-last-point flag is set or not, whether the next point is in +C the window or not, and whether the last point was in the window, not +C in the window, or non-existent (point 0 or a special-value point). +C + IF (LDLP.EQ.0) GO TO 102 + IF (NPOW.NE.0) GO TO 103 +C +C Line drawn to last point, next point inside, last point inside. +C + CALL VECTD (XNXT,YNXT) + LDLP=LDLP+1 + GO TO 119 +C + 102 IF (NPOW.NE.0) GO TO 109 + IF (LPOW.NE.0) GO TO 105 +C +C No line drawn to last point, next point inside, no last point. +C + CALL FRSTD (XNXT,YNXT) + LDLP=1 + GO TO 119 +C +C Line drawn to last point, next point outside, last point inside. +C + 103 XPIW=XLST + YPIW=YLST + XPOW=XNXT + YPOW=YNXT + ASSIGN 104 TO JUMP + GO TO 107 + 104 CALL VECTD (XPEW,YPEW) + CALL LASTD + LDLP=0 + GO TO 119 +C +C No line drawn to last point, next point inside, last point outside. +C + 105 XPIW=XNXT + YPIW=YNXT + XPOW=XLST + YPOW=YLST + ASSIGN 106 TO JUMP + GO TO 107 + 106 CALL FRSTD (XPEW,YPEW) + CALL VECTD (XNXT,YNXT) + LDLP=2 + GO TO 119 +C +C The following local procedure, given a point (XPIW,YPIW) inside the +C window and a point (XPOW,YPOW) outside the window, finds the point of +C intersection (XPEW,YPEW) of a line joining them with the window edge. +C + 107 XPEW=XPIW + YPEW=YPIW + XDIF=XPOW-XPIW + YDIF=YPOW-YPIW +C + IF (ABS(XDIF).GT.XEPS) THEN + XPEW=XMIN + IF (XDIF.GE.0.) XPEW=XMAX + YPEW=YPIW+(XPEW-XPIW)*YDIF/XDIF + IF (YPEW.GE.YMIN.AND.YPEW.LE.YMAX) GO TO 108 + END IF +C + IF (ABS(YDIF).GT.YEPS) THEN + YPEW=YMIN + IF (YDIF.GE.0.) YPEW=YMAX + XPEW=XPIW+(YPEW-YPIW)*XDIF/YDIF + END IF +C + 108 GO TO JUMP , (104,106) +C +C No line drawn to last point, next point outside. Jump if no last +C point. +C + 109 IF (LPOW.EQ.0) GO TO 119 +C +C No line drawn to last point, next point outside, last point outside. +C Check whether a portion of the line joining them lies in the window. +C + MPOW=9*LPOW+NPOW+41 +C + GO TO (119,119,119,119,119,110,119,110,110, + + 119,119,119,111,119,110,111,110,110, + + 119,119,119,111,119,119,111,111,119, + + 119,113,113,119,119,110,119,110,110, + + 119,119,119,119,119,119,119,119,119, + + 112,112,119,112,119,119,111,111,119, + + 119,113,113,119,119,113,119,119,119, + + 112,112,113,112,119,113,119,119,119, + + 112,112,119,112,119,119,119,119,119) , MPOW +C + 110 XPE1=XMIN + YPT1=YMIN + XPE2=XMAX + YPT2=YMAX + GO TO 114 +C + 111 XPE1=XMIN + YPT1=YMAX + XPE2=XMAX + YPT2=YMIN + GO TO 114 +C + 112 XPE1=XMAX + YPT1=YMAX + XPE2=XMIN + YPT2=YMIN + GO TO 114 +C + 113 XPE1=XMAX + YPT1=YMIN + XPE2=XMIN + YPT2=YMAX +C + 114 XDIF=XNXT-XLST + YDIF=YNXT-YLST +C + IF (ABS(XDIF).LE.XEPS) GO TO 116 + YPE1=YLST+(XPE1-XLST)*YDIF/XDIF + YPE2=YLST+(XPE2-XLST)*YDIF/XDIF +C + IF (ABS(YDIF).LE.YEPS) GO TO 118 + IF (YPE1.GE.YMIN.AND.YPE1.LE.YMAX) GO TO 115 + YPE1=YPT1 + XPE1=XLST+(YPE1-YLST)*XDIF/YDIF + IF (XPE1.LT.XMIN.OR.XPE1.GT.XMAX) GO TO 119 +C + 115 IF (YPE2.GE.YMIN.AND.YPE2.LE.YMAX) GO TO 118 + GO TO 117 +C + 116 YPE1=YPT1 + XPE1=XLST+(YPE1-YLST)*XDIF/YDIF + IF (XPE1.LT.XMIN.OR.XPE1.GT.XMAX) GO TO 119 +C + 117 YPE2=YPT2 + XPE2=XLST+(YPE2-YLST)*XDIF/YDIF + IF (XPE2.LT.XMIN.OR.XPE2.GT.XMAX) GO TO 119 +C + 118 CALL FRSTD (XPE1,YPE1) + CALL VECTD (XPE2,YPE2) + CALL LASTD +C +C Processing of next point is done. It becomes the last point and we +C go back for a new next point. +C + 119 LPOW=NPOW + XLST=XNXT + YLST=YNXT + GO TO 101 +C +C Last point was final point. Finish up. +C + 120 IF (LDLP.NE.0) THEN + IF (LDLP.EQ.1) CALL VECTD (XLST,YLST) + CALL LASTD + END IF +C +C Restore logarithmic mapping, if appropriate. +C + IF (LTYP.NE.1) + + CALL SET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW,LTYP) +C +C Return to caller. +C + RETURN +C +C Error exit. +C + 901 CALL SETER ('AGQURV - NUMBER OF POINTS IS LESS THAN OR EQUAL TO ZE + +RO',7,2) +C + END diff --git a/sys/gio/ncarutil/autograph/agrpch.f b/sys/gio/ncarutil/autograph/agrpch.f new file mode 100644 index 00000000..c37a7ae4 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agrpch.f @@ -0,0 +1,86 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGRPCH (CHST,LNCS,IDCS) +C + CHARACTER*(*) CHST +C +C This routine is used to replace a character string previously stored +C by the routine AGSTCH (which see). This could be done by an AGDLCH +C followed by an AGSTCH, and, in fact, under certain conditions, does +C exactly that. Only when it is easy to do so does AGRPCH operate more +C efficiently. Nevertheless, a user who (for example) repeatedly and +C perhaps redundantly defines x-axis labels of the same length may +C greatly benefit thereby; repeated deletes and stores would lead to +C frequent garbage collection by AGSTCH. +C +C AGRPCH has the following arguments: +C +C -- CHST is the new character string, to replace what was originally +C stored. +C +C -- LNCS is the length of the character string in CHST. +C +C -- IDCS is the identifier returned by AGSTCH when the original string +C was stored. The value of IDCS may be changed by the call. +C +C The following common blocks contain variables which are required for +C the character-storage-and-retrieval scheme of AUTOGRAPH. +C + COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA +C + COMMON /AGCHR2/ CHRA(2000) +C + CHARACTER*1 CHRA +C +C If the identifier is positive or is negative but less than -LNIC, the +C original string was never stored in CHRA; just treat the replacement +C as a store and return a new value of IDCS. +C + IF (IDCS.GT.(-1).OR.IDCS.LT.(-LNIC)) THEN + CALL AGSTCH (CHST,LNCS,IDCS) +C + ELSE +C +C The absolute value of the identifier is the index, in INCH, of the +C descriptor of the character string stored in CHRA. If the new string +C is shorter than the old one, store it and zero remaining character +C positions. Otherwise, treat the replacement as a delete followed by +C a store. +C + I=-IDCS + IF (LNCS.LE.INCH(2,I)) THEN + J=INCH(1,I)-1 + DO 101 K=1,LNCS + J=J+1 + CHRA(J)=CHST(K:K) + 101 CONTINUE + DO 102 K=LNCS+1,INCH(2,I) + J=J+1 + CHRA(J)=CHAR(0) + 102 CONTINUE + INCH(2,I)=LNCS + ELSE + CALL AGDLCH (IDCS) + CALL AGSTCH (CHST,LNCS,IDCS) + END IF +C + END IF +C +C Done. +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agrstr.f b/sys/gio/ncarutil/autograph/agrstr.f new file mode 100644 index 00000000..72afc643 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agrstr.f @@ -0,0 +1,88 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C +NOAO - this subroutine is a no-op in IRAF. +C --------------------------------------------------------------------- +C + SUBROUTINE AGRSTR (IFNO) +C +C This subroutine is called to restore the current state of AUTOGRAPH by +C reading all of its important variables from a record on the file which +C is associated with the unit number IFNO. +C +C The following common block contains the AUTOGRAPH control parameters, +C all of which are real. If it is changed, all of AUTOGRAPH (especially +C the routine AGSCAN) must be examined for possible side effects. +C + COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) , + + XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD , + + XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH , + + YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH , + + QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4), + + BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4), + + QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4), + + QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) , + + QODP,QCDP,WOCD,WODQ,QDSH(26) , + + QDLB,QBIM,FLLB(10,8),QBAN , + + QLLN,TCLN,QNIM,FLLN(6,16),QNAN , + + XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW , + + XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP , + + XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4), + + QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4), + + QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4), + + WNLE(4),QLUA(4) , + + RBOX(6),DBOX(6,4),SBOX(6,4) +C +C The following common block contains other AUTOGRAPH variables, both +C real and integer, which are not control parameters. +C + COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ , + + INIF +C +C The following common blocks contain variables which are required for +C the character-storage-and-retrieval scheme of AUTOGRAPH. +C + COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA +C + COMMON /AGCHR2/ CHRA(2000) +C + CHARACTER*1 CHRA +C +C Read the record. +C +C READ (IFNO,ERR=901,END=902) +C 1 BASD,BASE,DBOX,DNLA,FLLB,FLLN,FUNS,HCWP,PING,PINU,QBAC,QBAN,QBIM, +C 2 QBTD,QBTP,QCDP,QCEX,QCEY,QCIE,QCIM,QDAX,QDLB,QDSH,QFRA,QIXY,QJDP, +C 3 QLED,QLEX,QLFD,QLFL,QLLN,QLOF,QLOS,QLTD,QLTP,QLUA,QLUX,QLUY,QMJD, +C 4 QMND,QMNT,QNAN,QNDP,QNIM,QODP,QOVX,QOVY,QROW,QSET,QSPA,QWND,RBOX, +C 5 RFNL,SBOX,SCWP,SOGD,SVAL,TCLN,UBGA,UNDA,WCLE,WCLM,WCWP,WMJL,WMJR, +C 6 WMNL,WMNR,WNLB,WNLE,WNLL,WNLR,WOCD,WODQ,XBGA,XHGH,XLCW,XLGD,XLGF, +C 7 XLGW,XLOW,XLUW,XMAX,XMIN,XNDA,XRCW,XRGD,XRGF,XRGW,XRUW,YBCW,YBGA, +C 8 YBGD,YBGF,YBGW,YBUW,YHGH,YLOW,YMAX,YMIN,YNDA,YTCW,YTGD,YTGF,YTGW, +C 9 YTUW, +C + INIF,ISLD,MDLA,MWCD,MWCE,MWCL,MWCM,MWDQ,SMRL, +C 1 INCA,INCH,LNCA,LNIC, +C 2 CHRA +C +C Done. +C + RETURN +C +C Error exits. +C +C 901 CALL SETER ('AGRSTR - ERROR ON READ',8,2) +C +C 902 CALL SETER ('AGRSTR - END-OF-FILE ON READ',9,2) +C +C -NOAO + END diff --git a/sys/gio/ncarutil/autograph/agsave.f b/sys/gio/ncarutil/autograph/agsave.f new file mode 100644 index 00000000..ef0feb7d --- /dev/null +++ b/sys/gio/ncarutil/autograph/agsave.f @@ -0,0 +1,93 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C +NOAO - This routine is a no-op in IRAF. +C --------------------------------------------------------------------- +C + SUBROUTINE AGSAVE (IFNO) +C +C This subroutine is called to save the current state of AUTOGRAPH by +C writing all of its important variables as a record on the file which +C is associated with the unit number IFNO. +C +C The following common block contains the AUTOGRAPH control parameters, +C all of which are real. If it is changed, all of AUTOGRAPH (especially +C the routine AGSCAN) must be examined for possible side effects. +C + COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) , + + XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD , + + XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH , + + YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH , + + QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4), + + BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4), + + QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4), + + QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) , + + QODP,QCDP,WOCD,WODQ,QDSH(26) , + + QDLB,QBIM,FLLB(10,8),QBAN , + + QLLN,TCLN,QNIM,FLLN(6,16),QNAN , + + XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW , + + XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP , + + XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4), + + QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4), + + QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4), + + WNLE(4),QLUA(4) , + + RBOX(6),DBOX(6,4),SBOX(6,4) +C +C The following common block contains other AUTOGRAPH variables, both +C real and integer, which are not control parameters. +C + COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ , + + INIF +C +C The following common blocks contain variables which are required for +C the character-storage-and-retrieval scheme of AUTOGRAPH. +C + COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA +C + COMMON /AGCHR2/ CHRA(2000) +C + CHARACTER*1 CHRA +C +C If initialization has not yet been done, do it. +C + IF (INIF.EQ.0) THEN + CALL AGINIT + END IF +C +C Write the record. Variables from each COMMON block are together, in +C alphabetical order. +C +C WRITE (IFNO,ERR=901) +C 1 BASD,BASE,DBOX,DNLA,FLLB,FLLN,FUNS,HCWP,PING,PINU,QBAC,QBAN,QBIM, +C 2 QBTD,QBTP,QCDP,QCEX,QCEY,QCIE,QCIM,QDAX,QDLB,QDSH,QFRA,QIXY,QJDP, +C 3 QLED,QLEX,QLFD,QLFL,QLLN,QLOF,QLOS,QLTD,QLTP,QLUA,QLUX,QLUY,QMJD, +C 4 QMND,QMNT,QNAN,QNDP,QNIM,QODP,QOVX,QOVY,QROW,QSET,QSPA,QWND,RBOX, +C 5 RFNL,SBOX,SCWP,SOGD,SVAL,TCLN,UBGA,UNDA,WCLE,WCLM,WCWP,WMJL,WMJR, +C 6 WMNL,WMNR,WNLB,WNLE,WNLL,WNLR,WOCD,WODQ,XBGA,XHGH,XLCW,XLGD,XLGF, +C 7 XLGW,XLOW,XLUW,XMAX,XMIN,XNDA,XRCW,XRGD,XRGF,XRGW,XRUW,YBCW,YBGA, +C 8 YBGD,YBGF,YBGW,YBUW,YHGH,YLOW,YMAX,YMIN,YNDA,YTCW,YTGD,YTGF,YTGW, +C 9 YTUW, +C + INIF,ISLD,MDLA,MWCD,MWCE,MWCL,MWCM,MWDQ,SMRL, +C 1 INCA,INCH,LNCA,LNIC, +C 2 CHRA +C +C Done. +C + RETURN +C +C Error exit. +C +C 901 CALL SETER ('AGSAVE - ERROR ON WRITE',10,2) +C +C -NOAO + END diff --git a/sys/gio/ncarutil/autograph/agscan.f b/sys/gio/ncarutil/autograph/agscan.f new file mode 100644 index 00000000..222db6c4 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agscan.f @@ -0,0 +1,628 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGSCAN (TPID,LOPA,NIPA,IIPA) +C + CHARACTER*(*) TPID +C +C The routine AGSCAN is used by AGGETP and AGSETP to scan a parameter +C identifier and return a description of the parameter-list items which +C are specified by that parameter identifier. It has the following +C arguments: +C +C -- TPID is the parameter identifier. +C +C -- LOPA is the index of the first parameter-list item specified. +C +C -- NIPA is the number of parameter-list items specified. +C +C -- IIPA is the index increment between one of the parameter-list items +C specified and the next (meaningless if NIPA=1). +C +C +C BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE +C +C Originally, this routine used the function "LOC" to return, in LOPA, +C the base address, in core, of the specified parameter group. To some +C degree, it was thereby insulated from changes in the labelled common +C block AGCONP. With the demise of "LOC", LOPA has been re-defined and +C that insulation no longer exists. In the following code, there are +C integers which represent the indices of desired quantities in common. +C +C BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE BEWARE +C +C +C The following common block contains the AUTOGRAPH control parameters, +C all of which are real. If it is changed, all of AUTOGRAPH (especially +C the routine AGSCAN) must be examined for possible side effects. +C + COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) , + + XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD , + + XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH , + + YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH , + + QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4), + + BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4), + + QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4), + + QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) , + + QODP,QCDP,WOCD,WODQ,QDSH(26) , + + QDLB,QBIM,FLLB(10,8),QBAN , + + QLLN,TCLN,QNIM,FLLN(6,16),QNAN , + + XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW , + + XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP , + + XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4), + + QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4), + + QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4), + + WNLE(4),QLUA(4) , + + RBOX(6),DBOX(6,4),SBOX(6,4) +C +C Declare the block data routine EXTERNAL to force loading of it. +C +C +NOAO - call agdflt as run time initialization +C +C EXTERNAL AGDFLT + call agdflt +C -NOAO +C +C Initialize the parameter-identifier character index. +C + IPID=0 +C +C Initialize the value of the index increment to be returned. +C + IIPA=1 +C +C Find the first keyword in the parameter identifier. +C + CALL AGSRCH (TPID,IPID,IKWL,'PRIMFRAMSET ROW INVEWINDNULLGRAPGRIDX + + Y AXISLEFTRIGHBOTTTOP DASHLABELINESECOBACK') +C + GO TO (101,102,103,104,105,106,107,108,109,110, + + 111,113,114,114,114,114,132,133,147,155,166,901) , IKWL +C +C PRIMARY CONTROL PARAMETERS. +C + 101 LOPA=1 + NIPA=336 + GO TO 203 +C +C FRAME PARAMETER. +C + 102 LOPA=1 + GO TO 202 +C +C SET PARAMETER. +C + 103 LOPA=2 + GO TO 202 +C +C ROW PARAMETER. +C + 104 LOPA=3 + GO TO 202 +C +C X/Y INVERSION PARAMETER. +C + 105 LOPA=4 + GO TO 202 +C +C WINDOWING PARAMETER. +C + 106 LOPA=5 + GO TO 202 +C +C BACKGROUND PARAMETER. +C + 166 LOPA=6 + GO TO 202 +C +C NULL PARAMETER(S). +C + 107 LOPA=7 + NIPA=2 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'1 2 ') +C + IF (IKWL.EQ.3) GO TO 901 + GO TO 201 +C +C PLOT (GRAPH) WINDOW PARAMETERS. +C + 108 LOPA=9 + NIPA=4 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'LEFTRIGHBOTTTOP ') +C + IF (IKWL.EQ.5) GO TO 901 + GO TO 201 +C +C GRID WINDOW PARAMETERS. +C + 109 LOPA=13 + NIPA=5 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'LEFTRIGHBOTTTOP SHAP') +C + IF (IKWL.EQ.6) GO TO 901 + GO TO 201 +C +C X DATA PARAMETERS. +C + 110 LOPA=18 + GO TO 112 +C +C Y DATA PARAMETERS. +C + 111 LOPA=25 +C +C X OR Y DATA PARAMETERS. +C + 112 NIPA=7 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'MINIMAXILOGAORDENICESMALLARG') +C + IF (IKWL.EQ.8) GO TO 901 + GO TO 201 +C +C AXIS PARAMETERS. +C + 113 LOPA=32 + NIPA=92 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'LEFTRIGHBOTTTOP ') +C + IF (IKWL.EQ.5) GO TO 901 + IKWL=IKWL+12 +C +C LEFT, RIGHT, BOTTOM, OR TOP AXIS PARAMETERS. +C + 114 LOPA=19+IKWL + NIPA=23 + IIPA=4 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL, + + 'CONTLINEINTEFUNCTICKMAJOMINONUMETYPEEXPOFRACANGLOFFSWIDT') +C + GO TO (202,201,115,167,116,117,123,126,127,127,127, + + 127,127,127,901) , IKWL +C +C AXIS INTERSECTION PARAMETERS. +C + 115 LOPA=LOPA+8 + NIPA=2 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'GRIDUSER') +C + IF (IKWL.EQ.3) GO TO 901 + GO TO 201 +C +C AXIS MAPPING FUNCTION. +C + 167 LOPA=LOPA+16 + GO TO 202 +C +C AXIS TICK PARAMETERS. +C + 116 LOPA=LOPA+20 + NIPA=10 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'MAJOMINO') +C + LOPA=LOPA-20 + GO TO (117,123,901) , IKWL +C +C AXIS MAJOR-TICK PARAMETERS. +C + 117 LOPA=LOPA+20 + NIPA=6 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'SPACTYPEBASECOUNPATTLENGOUTWINWA') +C + GO TO (118,119,119,119,120,121,122,122,901) , IKWL +C +C AXIS MAJOR-TICK SPACING PARAMETERS. +C + 118 NIPA=3 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'TYPEBASECOUN') +C + IF (IKWL.EQ.4) GO TO 901 +C + GO TO 201 +C + 119 IKWL=IKWL-1 + GO TO 201 +C +C AXIS MAJOR-TICK DASH PATTERN. +C + 120 LOPA=LOPA+12 + GO TO 202 +C +C AXIS MAJOR-TICK LENGTH PARAMETERS. +C + 121 LOPA=LOPA+16 + NIPA=2 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'OUTWINWA') +C + IF (IKWL.EQ.3) GO TO 901 + GO TO 201 +C + 122 LOPA=LOPA+16 + IKWL=IKWL-6 + GO TO 201 +C +C AXIS MINOR-TICK PARAMETERS. +C + 123 LOPA=LOPA+44 + NIPA=4 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'SPACPATTLENGOUTWINWA') +C + GO TO (202,201,124,125,125,901) , IKWL +C +C AXIS MINOR-TICK LENGTH PARAMETERS. +C + 124 LOPA=LOPA+8 + NIPA=2 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'OUTWINWA') +C + IF (IKWL.EQ.3) GO TO 901 + GO TO 201 +C + 125 LOPA=LOPA+8 + IKWL=IKWL-3 + GO TO 201 +C +C AXIS NUMERIC-LABEL PARAMETERS. +C + 126 LOPA=LOPA+60 + NIPA=8 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'TYPEEXPOFRACANGLOFFSWIDT') +C + GO TO 128 +C + 127 LOPA=LOPA+60 + IKWL=IKWL-8 +C + 128 GO TO (202,201,201,129,130,131,901) ,IKWL +C +C AXIS NUMERIC-LABEL ORIENTATION ANGLE. +C + 129 LOPA=LOPA+12 + NIPA=2 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'1ST 2ND ') +C + IF (IKWL.EQ.3) GO TO 901 + GO TO 201 +C +C AXIS NUMERIC-LABEL OFFSET. +C + 130 LOPA=LOPA+20 + GO TO 202 +C +C AXIS NUMERIC-LABEL WIDTH PARAMETERS. +C + 131 LOPA=LOPA+24 + NIPA=2 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'MANTEXPO') +C + IF (IKWL.EQ.3) GO TO 901 + GO TO 201 +C +C DASH-PATTERN PARAMETERS. +C + 132 LOPA=124 + NIPA=30 + IF (TPID(IPID:IPID).EQ.'.') RETURN + JPID=IPID + CALL AGSRCH (TPID,IPID,IKWL,'SELELENGCHARDOLLPATT') + IF (IKWL.EQ.6) THEN + IPID=JPID + GO TO 168 + END IF + IF (IKWL.NE.5) GO TO 201 + 168 LOPA=LOPA+4 + NIPA=26 + IF (TPID(IPID:IPID).EQ.'.') RETURN + CALL AGSRCH (TPID,IPID,IKWL, + +'1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 1 + +7 18 19 20 21 22 23 24 25 26 ') + IF (IKWL.EQ.27) GO TO 901 + GO TO 201 +C +C LABEL PARAMETERS. +C + 133 LBIM=IFIX(QBIM) + LBAN=IFIX(QBAN) +C + LOPA=154 + NIPA=3+LBIM*10 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL, + + 'CONTBUFFNAMEDEFISUPPBASEOFFSANGLCENTLINEINDE') +C + GO TO (202,136,139,140,141,141,141,141,141,141,141,901) , IKWL +C +C LABEL BUFFER PARAMETERS. +C + 136 LOPA=155 + NIPA=1+LBIM*10 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'LENGCONTNAME') +C + GO TO (202,137,138,901) , IKWL +C +C LABEL BUFFER CONTENTS. +C + 137 LOPA=156 + NIPA=LBIM*10 + GO TO 203 +C +C LABEL BUFFER NAMES. +C + 138 LOPA=156 + NIPA=LBIM + IIPA=10 + GO TO 203 +C +C LABEL NAME. +C + 139 LOPA=236 + GO TO 202 +C +C LABEL DEFINITION. +C + 140 IF (LBAN.LT.1.OR.LBAN.GT.LBIM) GO TO 902 +C + LOPA=157+(LBAN-1)*10 + NIPA=9 + IF (TPID(IPID:IPID).EQ.'.') GO TO 203 +C + CALL AGSRCH (TPID,IPID,IKWL,'SUPPBASEOFFSANGLCENTLINEINDE') +C + GO TO 142 +C + 141 IF (LBAN.LT.1.OR.LBAN.GT.LBIM) GO TO 902 +C + LOPA=157+(LBAN-1)*10 + IKWL=IKWL-4 +C + 142 GO TO (202,143,144,146,146,146,146,901) , IKWL +C +C LABEL POSITION. +C + 143 LOPA=LOPA+1 + GO TO 145 +C +C LABEL OFFSET. +C + 144 LOPA=LOPA+3 +C +C LABEL POSITION OR OFFSET. +C + 145 NIPA=2 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'X Y ') +C + IF (IKWL.EQ.3) GO TO 901 + GO TO 201 +C +C OTHER LABEL ATTRIBUTES. +C + 146 LOPA=LOPA+5 + IKWL=IKWL-3 + GO TO 201 +C +C LINE PARAMETERS. +C + 147 LNIM=IFIX(QNIM) + LNAN=IFIX(QNAN) +C + LOPA=237 + NIPA=4+LNIM*6 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL, + + 'MAXIEND BUFFNUMBDEFISUPPCHARTEXTLENGINDE') +C + GO TO (202,201,150,152,153,154,154,154,154,154,901) , IKWL +C +C LINE BUFFER PARAMETERS. +C + 150 LOPA=239 + NIPA=1+LNIM*6 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'LENGCONT') +C + GO TO (202,151,901) , IKWL +C +C LINE BUFFER CONTENTS. +C + 151 LOPA=240 + NIPA=LNIM*6 + GO TO 203 +C +C LINE NUMBER. +C + 152 LOPA=336 + GO TO 202 +C +C LINE DEFINITION. +C + 153 IF (LNAN.LT.1.OR.LNAN.GT.LNIM) GO TO 903 +C + LOPA=241+(LNAN-1)*6 + NIPA=5 + IF (TPID(IPID:IPID).EQ.'.') GO TO 203 +C + CALL AGSRCH (TPID,IPID,IKWL,'SUPPCHARTEXTLENGINDE') +C + IF (IKWL.EQ.6) GO TO 901 + GO TO 201 +C + 154 IF (LNAN.LT.1.OR.LNAN.GT.LNIM) GO TO 903 + LOPA=241+(LNAN-1)*6 + IKWL=IKWL-5 + GO TO 201 +C +C SECONDARY CONTROL PARAMETERS. +C + 155 LOPA=337 + NIPA=149 + IF (TPID(IPID:IPID).EQ.'.') GO TO 203 +C + CALL AGSRCH (TPID,IPID,IKWL, + + 'GRAPUSERCURVDIMEAXISLEFTRIGHBOTTTOP LABE') +C + GO TO (156,157,158,159,160,161,161,161,161,165,901) , IKWL +C +C PLOT (GRAPH) WINDOW EDGES. +C + 156 LOPA=337 + NIPA=4 + GO TO 203 +C +C USER WINDOW PARAMETERS. +C + 157 LOPA=341 + NIPA=4 + GO TO 203 +C +C CURVE WINDOW PARAMETERS. +C + 158 LOPA=345 + NIPA=4 + GO TO 203 +C +C CURVE WINDOW DIMENSIONS. +C + 159 LOPA=349 + NIPA=3 + GO TO 203 +C +C AXIS PARAMETERS. +C + 160 LOPA=352 + NIPA=80 + IF (TPID(IPID:IPID).EQ.'.') GO TO 203 +C + CALL AGSRCH (TPID,IPID,IKWL,'LEFTRIGHBOTTTOP ') +C + IF (IKWL.EQ.5) GO TO 901 +C + IKWL=IKWL+5 +C +C LEFT, RIGHT, BOTTOM, OR TOP AXIS PARAMETERS. +C + 161 LOPA=346+IKWL + NIPA=20 + IIPA=4 + IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGSRCH (TPID,IPID,IKWL,'POSITICKNUME') +C + GO TO (162,163,164,901) , IKWL +C +C AXIS POSITIONING PARAMETERS. +C + 162 NIPA=6 + GO TO 203 +C +C AXIS TICK PARAMETERS. +C + 163 LOPA=LOPA+24 + NIPA=3 + GO TO 203 +C +C AXIS NUMERIC-LABEL PARAMETERS. +C + 164 LOPA=LOPA+36 + NIPA=11 + GO TO 203 +C +C LABEL BOXES. +C + 165 LOPA=432 + NIPA=54 + IF (TPID(IPID:IPID).EQ.'.') GO TO 203 +C + CALL AGSRCH (TPID,IPID,IKWL,'LEFTRIGHBOTTTOP CENTGRAP') +C + IF (IKWL.EQ.7) GO TO 901 +C + LOPA=LOPA+IKWL-1 + NIPA=9 + IIPA=6 + GO TO 203 +C +C Normal exits. +C + 201 LOPA=LOPA+(IKWL-1)*IIPA +C + 202 NIPA=1 +C + 203 IF (TPID(IPID:IPID).EQ.'.') RETURN +C + CALL AGPPID (TPID) +C +NOAO - following FTN write and fmt statements commented out, SETER is okay. +C +C WRITE (I1MACH(4),1001) + RETURN +C +C Error exits. +C + 901 CALL AGPPID (TPID) + CALL SETER ('AGGETP OR AGSETP - ILLEGAL KEYWORD USED IN PARAMETER + +IDENTIFIER',11,2) +C + 902 CALL AGPPID (TPID) + CALL SETER ('AGGETP OR AGSETP - ATTEMPT TO ACCESS LABEL ATTRIBUTES + + BEFORE SETTING LABEL NAME',12,2) +C + 903 CALL AGPPID (TPID) + CALL SETER ('AGGETP OR AGSETP - ATTEMPT TO ACCESS LINE ATTRIBUTES + +BEFORE SETTING LINE NUMBER',13,2) +C +C Formats. +C +C1001 FORMAT (' WARNING - ABOVE PARAMETER IDENTIFIER HAS TOO MANY KEYWOR +C +DS') +C +C -NOAO + END diff --git a/sys/gio/ncarutil/autograph/agsetc.f b/sys/gio/ncarutil/autograph/agsetc.f new file mode 100644 index 00000000..bced8458 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agsetc.f @@ -0,0 +1,100 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGSETC (TPID,CUSR) +C + CHARACTER*(*) TPID,CUSR +C + DIMENSION FURA(1) +C +C The routine AGSETC is used to set the values of individual AUTOGRAPH +C parameters which intrinsically represent character strings. TPID is a +C parameter identifier. CUSR is a character string. The situation is +C complicated by the fact that the character string may be either a dash +C pattern, the name of a label, the line-end character, or the text of a +C line, all of which are treated differently. +C +C Define a local variable to hold the "line-end" character. +C + CHARACTER*1 LEND +C +C See what kind of parameter is being set. +C + CALL AGCTCS (TPID,ITCS) +C +C If the parameter is not intrinsically of type character, log an error. +C + IF (ITCS.EQ.0) GO TO 901 +C +C Find the length of the string, which may or may not actually be used. +C (On the Cray, at least, it may be zero if the wrong type of argument +C was used.) +C + ILEN=LEN(CUSR) +C +C Retrieve the current (integer) value of the parameter. +C + CALL AGGETI (TPID,ITMP) +C +C Check for a dash pattern. +C + IF (ITCS.EQ.1) THEN + CALL AGGETI ('DASH/LENG.',NCHR) + IF (ILEN.GT.0.AND.ILEN.LT.NCHR) NCHR=ILEN + CALL AGRPCH (CUSR,NCHR,ITMP) +C +C Check for a label name. +C + ELSE IF (ITCS.EQ.2) THEN + CALL AGRPCH (CUSR,MAX0(1,ILEN),ITMP) +C +C Check for the line-end character. +C + ELSE IF (ITCS.EQ.3) THEN + CALL AGRPCH (CUSR,1,ITMP) +C +C Check for the text of a label. +C + ELSE IF (ITCS.EQ.4) THEN + CALL AGGETI ('LINE/MAXI.',NCHR) + IF (ILEN.GT.0) NCHR=MIN0(NCHR,ILEN) + CALL AGGETC ('LINE/END .',LEND) + DO 101 I=1,NCHR + IF (CUSR(I:I).EQ.LEND) THEN + NCHR=I-1 + GO TO 102 + END IF + 101 CONTINUE +C + 102 CALL AGRPCH (CUSR,NCHR,ITMP) +C + END IF +C +C Transfer the generated value to the list of AUTOGRAPH parameters. +C + FURA(1)=FLOAT(ITMP) + CALL AGSETP (TPID,FURA,1) +C +C Done. +C + RETURN +C +C Error exit. +C + 901 CALL AGPPID (TPID) + CALL SETER ('AGSETC - PARAMETER TO SET IS NOT INTRINSICALLY OF TYP + +E CHARACTER',14,2) +C + END diff --git a/sys/gio/ncarutil/autograph/agsetf.f b/sys/gio/ncarutil/autograph/agsetf.f new file mode 100644 index 00000000..36fca46e --- /dev/null +++ b/sys/gio/ncarutil/autograph/agsetf.f @@ -0,0 +1,28 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGSETF (TPID,FUSR) +C + CHARACTER*(*) TPID + DIMENSION FURA(1) +C +C The routine AGSETF may be used to set the real (floating-point) value +C of any single AUTOGRAPH control parameter. +C + FURA(1)=FUSR + CALL AGSETP (TPID,FURA,1) + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agseti.f b/sys/gio/ncarutil/autograph/agseti.f new file mode 100644 index 00000000..06e3b3f1 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agseti.f @@ -0,0 +1,28 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGSETI (TPID,IUSR) +C + CHARACTER*(*) TPID + DIMENSION FURA(1) +C +C The routine AGSETI may be used to set the integer-equivalent value of +C any single AUTOGRAPH control parameter. +C + FURA(1)=FLOAT(IUSR) + CALL AGSETP (TPID,FURA,1) + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agsetp.f b/sys/gio/ncarutil/autograph/agsetp.f new file mode 100644 index 00000000..95e98a6d --- /dev/null +++ b/sys/gio/ncarutil/autograph/agsetp.f @@ -0,0 +1,447 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGSETP (TPID,FURA,LURA) +C + CHARACTER*(*) TPID + DIMENSION FURA(LURA) +C +C The routine AGSETP stores user-provided values of the AUTOGRAPH +C parameters specified by the parameter identifier TPID. The arguments +C are as follows: +C +C -- TPID is the parameter identifier, a string of keywords separated +C from each other by slashes and followed by a period. +C +C -- FURA is the user array from which parameter values are to be taken. +C +C -- LURA is the length of the user array. +C +C The following common block contains the AUTOGRAPH control parameters, +C all of which are real. If it is changed, all of AUTOGRAPH (especially +C the routine AGSCAN) must be examined for possible side effects. +C + COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) , + + XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD , + + XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH , + + YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH , + + QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4), + + BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4), + + QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4), + + QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) , + + QODP,QCDP,WOCD,WODQ,QDSH(26) , + + QDLB,QBIM,FLLB(10,8),QBAN , + + QLLN,TCLN,QNIM,FLLN(6,16),QNAN , + + XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW , + + XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP , + + XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4), + + QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4), + + QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4), + + WNLE(4),QLUA(4) , + + RBOX(6),DBOX(6,4),SBOX(6,4) +C +C The following common block contains other AUTOGRAPH variables, both +C real and integer, which are not control parameters. +C + COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ , + + INIF +C +C The following common block contains other AUTOGRAPH variables, of type +C character. +C + COMMON /AGOCHP/ CHS1,CHS2 +C +c+noao +c CHARACTER*504 CHS1,CHS2 + CHARACTER*500 CHS1,CHS2 +c-noao +C +C Define the array DUMI, which allows access to the control-parameter +C list as an array. +C + DIMENSION DUMI(1) + EQUIVALENCE (QFRA,DUMI) +C +C +NOAO - Make sure common has been initialized. +C + call agdflt +C +C -NOAO +C If initialization has not yet been done, do it. +C + IF (INIF.EQ.0) THEN + CALL AGINIT + END IF +C +C The routine AGSCAN is called to scan the parameter identifier and to +C return three quantities describing the AUTOGRAPH parameters affected. +C + CALL AGSCAN (TPID,LOPA,NIPA,IIPA) +C +C Determine the number of values to transfer. +C + NURA=MAX0(1,MIN0(LURA,NIPA)) +C +C If character-string dash patterns are being replaced by integer dash +C patterns, reclaim the space used in the character-storage arrays. +C + CALL AGSCAN ('DASH/PATT.',LODP,NIDP,IIDP) + IF (LOPA.LE.LODP+NIDP-1.AND.LOPA+NURA-1.GE.LODP) THEN + MINI=MAX0(LOPA,LODP)-LOPA+1 + MAXI=MIN0(LOPA+NURA-1,LODP+NIDP-1)-LOPA+1 + DO 100 I=MINI,MAXI + IF (FURA(I).GT.0.) CALL AGDLCH (IFIX(DUMI(LOPA+I-1))) + 100 CONTINUE + END IF +C +C Save the current values of special values 1 and 2. +C + SVL1=SVAL(1) + SVL2=SVAL(2) +C +C Transfer the user-provided values to the parameter list. +C + IDMI=LOPA-IIPA +C + DO 101 IURA=1,NURA + IDMI=IDMI+IIPA + DUMI(IDMI)=FURA(IURA) + 101 CONTINUE +C +C If a specific item was changed, we may have a bit more work to do; +C otherwise, return to the user. +C + IF (NIPA.NE.1) RETURN +C +C If the specific item was special value 1 or 2, scan the primary list +C of parameters for other occurrences of the special value and change +C them to the new value. +C + IF (SVAL(1).NE.SVL1) THEN + SVLO=SVL1 + SVLN=SVAL(1) + GO TO 102 + END IF +C + IF (SVAL(2).NE.SVL2) THEN + SVLO=SVL2 + SVLN=SVAL(2) + GO TO 102 + END IF +C + GO TO 104 +C + 102 CALL AGSCAN ('PRIM.',LOPR,NIPR,IIPR) +C + IDMI=LOPR-IIPR +C + DO 103 I=1,NIPR + IDMI=IDMI+IIPR + IF (DUMI(IDMI).EQ.SVLO) DUMI(IDMI)=SVLN + 103 CONTINUE +C + RETURN +C +C If the specific item was the label control flag and it was set +C negative, delete all labels and lines. +C + 104 CALL AGSCAN ('LABE/CONT.',LOLC,NILC,IILC) + IF (LOPA.NE.LOLC) GO TO 107 + IF (QDLB.GE.0.) RETURN +C + QBAN=0. + QNAN=0. +C + LBIM=IFIX(QBIM) +C + DO 105 I=1,LBIM + IF (FLLB(1,I).NE.0.) THEN + CALL AGDLCH (IFIX(FLLB(1,I))) + FLLB(1,I)=0. + END IF + 105 CONTINUE +C + LNIM=IFIX(QNIM) +C + DO 106 I=1,LNIM + IF (FLLN(1,I).NE.SVAL(1)) THEN + CALL AGDLCH (IFIX(FLLN(4,I))) + FLLN(1,I)=SVAL(1) + END IF + 106 CONTINUE +C + RETURN +C +C If the specific item was the label name, reset it to an appropriate +C index in the label list, providing initial values if appropriate. +C + 107 CALL AGSCAN ('LABE/NAME.',LOLN,NILN,IILN) + IF (LOPA.NE.LOLN) GO TO 109 +C + LBAN=0 + LBIM=IFIX(QBIM) + QNAN=0. +C + CALL AGGTCH (IFIX(FURA(1)),CHS1,LCS1) +C + DO 108 I=1,LBIM + IF (LBAN.EQ.0.AND.FLLB(1,I).EQ.0.) LBAN=I + CALL AGGTCH (IFIX(FLLB(1,I)),CHS2,LCS2) + IF (LCS1.NE.LCS2) GO TO 108 + IF (CHS1(1:LCS1).NE.CHS2(1:LCS2)) GO TO 108 + QBAN=FLOAT(I) + RETURN + 108 CONTINUE +C + IF (LBAN.EQ.0) GO TO 901 +C + QBAN=FLOAT(LBAN) +C + FLLB( 1,LBAN)=FURA(1) + FLLB( 2,LBAN)=0. + FLLB( 3,LBAN)=.5 + FLLB( 4,LBAN)=.5 + FLLB( 5,LBAN)=0. + FLLB( 6,LBAN)=0. + FLLB( 7,LBAN)=0. + FLLB( 8,LBAN)=0. + FLLB( 9,LBAN)=0. + FLLB(10,LBAN)=0. +C + RETURN +C +C If the label access name is not set, skip. +C + 109 IF (QBAN.LE.0.) GO TO 122 +C + LBAN=IFIX(QBAN) + LBIM=IFIX(QBIM) + LNAN=IFIX(QNAN) + LNIM=IFIX(QNIM) +C +C If the specific item was the suppression flag for the current label +C and it was set negative, delete the label and/or its lines. +C + CALL AGSCAN ('LABE/SUPP.',LOLS,NILS,IILS) + IF (LOPA.NE.LOLS) GO TO 111 + IF (FLLB(2,LBAN).GE.0.) RETURN +C + ITMP=IFIX(FLLB(2,LBAN)) + FLLB(2,LBAN)=0. + FLLB(9,LBAN)=0. + LNIN=IFIX(FLLB(10,LBAN)) + FLLB(10,LBAN)=0. + QNAN=0. + IF (ITMP.EQ.(-1)) GO TO 110 + CALL AGDLCH (IFIX(FLLB(1,LBAN))) + FLLB(1,LBAN)=0. + QBAN=0. +C + 110 IF (LNIN.LT.1.OR.LNIN.GT.LNIM) RETURN + FLLN(1,LNIN)=SVAL(1) + CALL AGDLCH (IFIX(FLLN(4,LNIN))) + LNIN=IFIX(FLLN(6,LNIN)) + GO TO 110 +C +C If the specific item was the line number, reset it to an appropriate +C index in the line list, providing initial values if appropriate. +C + 111 CALL AGSCAN ('LINE/NUMB.',LOLN,NILN,IILN) + IF (LOPA.NE.LOLN) GO TO 118 +C + LNIL=0 + LNIN=IFIX(FLLB(10,LBAN)) +C + 112 IF (LNIN.LT.1.OR.LNIN.GT.LNIM) GO TO 115 + IF (LNAN-IFIX(FLLN(1,LNIN))) 113,114,115 +C + 113 LNIL=LNIN + LNIN=IFIX(FLLN(6,LNIN)) + GO TO 112 +C + 114 QNAN=FLOAT(LNIN) + RETURN +C + 115 DO 116 I=1,LNIM + LNIT=I + IF (FLLN(1,I).EQ.SVAL(1)) GO TO 117 + 116 CONTINUE +C + GO TO 903 +C + 117 CALL AGSTCH (' ',1,ITMP) +C + FLLN(1,LNIT)=FLOAT(LNAN) + FLLN(2,LNIT)=0. + FLLN(3,LNIT)=.015 + FLLN(4,LNIT)=ITMP + FLLN(5,LNIT)=1. + FLLN(6,LNIT)=FLOAT(LNIN) +C + LNAN=LNIT + IF (LNIL.EQ.0) FLLB(10,LBAN)=FLOAT(LNAN) + IF (LNIL.NE.0) FLLN( 6,LNIL)=FLOAT(LNAN) +C + FLLB(9,LBAN)=FLLB(9,LBAN)+1. +C + QNAN=FLOAT(LNAN) + RETURN +C +C If the line access number is not set, skip. +C + 118 IF (LNAN.LE.0) GO TO 122 +C +C If the specific item was the suppression flag for the current line and +C it was set negative, delete the line. +C + CALL AGSCAN ('LINE/SUPP.',LOLS,NILS,IILS) + IF (LOPA.NE.LOLS) GO TO 121 + IF (FLLN(2,LNAN).GE.0.) RETURN +C + LNIL=0 + LNIN=IFIX(FLLB(10,LBAN)) +C + 119 IF (LNIN.LT.1.OR.LNIN.GT.LNIM) RETURN + IF (LNAN.EQ.LNIN) GO TO 120 + LNIL=LNIN + LNIN=IFIX(FLLN(6,LNIN)) + GO TO 119 +C + 120 IF (LNIL.EQ.0) FLLB(10,LBAN)=FLLN(6,LNAN) + IF (LNIL.NE.0) FLLN( 6,LNIL)=FLLN(6,LNAN) + FLLN(1,LNAN)=SVAL(1) + CALL AGDLCH (IFIX(FLLN(4,LNAN))) + QNAN=0. + RETURN +C +C If the specific item was the text of a line, set the length of the +C line, as well. +C + 121 CALL AGSCAN ('LINE/TEXT.',LOLT,NILT,IILT) + IF (LOPA.NE.LOLT) GO TO 123 + CALL AGGTCH (IFIX(FURA(1)),CHS1,LCS1) + FLLN(5,LNAN)=FLOAT(LCS1) + RETURN +C +C See if the user is trying to get at a line of a non-existent label. +C + 122 CALL AGSCAN ('LINE/NUMB.',LOLN,NILN,IILN) + IF (LOPA.EQ.LOLN) GO TO 902 +C +C If the specific item was the background parameter, set up the back- +C ground requested by the user. +C + 123 CALL AGSCAN ('BACK.',LOBG,NIBG,IIBG) + IF (LOPA.NE.LOBG) GO TO 130 +C + QBAC=AMAX1(1.,AMIN1(4.,QBAC)) + IBAC=IFIX(QBAC) + GO TO (124,125,126,127) , IBAC +C +C Perimeter background. +C + 124 QLBC=4. + QRTC=4. + WMJI=.015 + WMNI=.010 + GO TO 128 +C +C Grid background. +C + 125 QLBC=4. + QRTC=-1. + WMJI=1. + WMNI=1. + GO TO 128 +C +C Half-axis background. +C + 126 QLBC=4. + QRTC=0. + WMJI=.015 + WMNI=.010 + GO TO 128 +C +C No background. +C + 127 QLBC=0. + QRTC=0. + WMJI=.015 + WMNI=.010 +C + 128 QDAX(1)=QLBC + QDAX(2)=QRTC + QDAX(3)=QLBC + QDAX(4)=QRTC +C + DO 129 I=1,4 + WMJR(I)=WMJI + WMNR(I)=WMNI + 129 CONTINUE +C + QDLB=FLOAT(2-2*(IBAC/4)) + RETURN +C +C If the specific item was the get-limits-from-last-SET-call parameter, +C do what is necessary. +C + 130 CALL AGSCAN ('SET .',LOSE,NISE,IISE) + IF (LOPA.NE.LOSE) GO TO 131 +C + QSET=SIGN(AMAX1(1.,AMIN1(4.,ABS(QSET))),QSET) +C + XLGD=.15 + XRGD=.95 + YBGD=.15 + YTGD=.95 + SOGD=0. +C + XMIN=SVAL(1) + XMAX=SVAL(1) + QLUX=AMIN1(QLUX,0.) + QOVX=0. + QCEX=-1. + XLOW=SVAL(1) + XHGH=SVAL(1) +C + YMIN=SVAL(1) + YMAX=SVAL(1) + QLUY=AMIN1(QLUY,0.) + QOVY=0. + QCEY=-1. + YLOW=SVAL(1) + YHGH=SVAL(1) +C + RETURN +C +C Return to caller. +C + 131 RETURN +C +C Error exits. +C + 901 CALL AGPPID (TPID) + CALL SETER ('AGSETP - LABEL LIST OVERFLOW - SEE AUTOGRAPH SPECIALI + +ST',15,2) +C + 902 CALL AGPPID (TPID) + CALL SETER ('AGSETP - ATTEMPT TO DEFINE LINE OF NON-EXISTENT LABEL + +',16,2) +C + 903 CALL AGPPID (TPID) + CALL SETER ('AGSETP - LINE LIST OVERFLOW - SEE AUTOGRAPH SPECIALIS + +T',17,2) +C + END diff --git a/sys/gio/ncarutil/autograph/agsrch.f b/sys/gio/ncarutil/autograph/agsrch.f new file mode 100644 index 00000000..366c46cc --- /dev/null +++ b/sys/gio/ncarutil/autograph/agsrch.f @@ -0,0 +1,96 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGSRCH (TPID,IPID,IKWL,TKWL) +C + CHARACTER*(*) TPID,TKWL +C +C The routine AGSRCH is used by AGSCAN to search a parameter identifier +C for the next keyword and return the index of that keyword in a list of +C keywords. It has the following arguments. +C +C -- TPID is the parameter identifier, a character string. +C +C -- IPID is the index of the last character examined in TPID. It is +C updated by AGSRCH to point to the first slash or period following +C the next keyword. +C +C -- IKWL is returned containing the index (in the keyword list) of the +C next keyword in the parameter identifier (list length, plus one, +C if the keyword is not found in the list). +C +C -- TKWL is the keyword list - 4*LKWL characters in all. +C +C ICHR is used to hold up to four characters of a keyword. +C + CHARACTER*4 ICHR +C +C LPID is the assumed maximum length of a parameter identifier. +C + DATA LPID / 100 / +C +C Compute the number of 4-character keywords in the keyword list. +C + LKWL=LEN(TKWL)/4 +C +C Find the next non-blank in the parameter identifier. +C + 101 IPID=IPID+1 + IF (IPID.GT.LPID) GO TO 107 + IF (TPID(IPID:IPID).EQ.' ') GO TO 101 +C +C Pick up at most four characters of the keyword, stopping on the first +C blank, slash, or period encountered. +C + NCHR=0 +C + 102 IF (TPID(IPID:IPID).EQ.' '.OR. + + TPID(IPID:IPID).EQ.'/'.OR. + + TPID(IPID:IPID).EQ.'.') GO TO 103 +C + NCHR=NCHR+1 + ICHR(NCHR:NCHR)=TPID(IPID:IPID) +C + IPID=IPID+1 +C + IF (NCHR.LT.4) GO TO 102 +C +C If the keyword found has zero length, error. +C + 103 IF (NCHR.EQ.0) GO TO 107 +C +C Scan ahead for the next slash or period. +C + 104 IF (TPID(IPID:IPID).EQ.'/'.OR.TPID(IPID:IPID).EQ.'.') GO TO 105 +C + IPID=IPID+1 + IF (IPID.GT.LPID) GO TO 107 + GO TO 104 +C +C Search the keyword list for the keyword found. +C + 105 DO 106 I=1,LKWL + IKWL=I + ISTR=(I-1)*4+1 + IEND=(I-1)*4+NCHR + IF (ICHR(1:NCHR).EQ.TKWL(ISTR:IEND)) RETURN + 106 CONTINUE +C +C Keyword not found - set IKWL to impossible value and return. +C + 107 IKWL=LKWL+1 + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/agstch.f b/sys/gio/ncarutil/autograph/agstch.f new file mode 100644 index 00000000..2b2906bd --- /dev/null +++ b/sys/gio/ncarutil/autograph/agstch.f @@ -0,0 +1,124 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGSTCH (CHST,LNCS,IDCS) +C + CHARACTER*(*) CHST +C +C This routine stores strings of characters for later retrieval and/or +C modification by the routines AGGTCH, AGRPCH, and AGDLCH. It has the +C following arguments: +C +C -- CHST is the character string to be stored. +C +C -- LNCS is the length of the character string in CHST. LNCS must be +C less than or equal to the value of the FORTRAN function LEN(CHST). +C +C -- IDCS is an identifying integer, returned to the caller by AGSTCH +C for later use in calls to AGGTCH, AGRPCH, and AGDLCH. If CHST is +C more than one character long, it is stashed in the array CHRA, and +C the value returned in IDCS is a negative number between -LNIC and +C -1, inclusive, the absolute value of which is the index of an entry +C in the array INCH describing where in the array CHRA the string was +C stored. If CHST is only one character long, IDCS is returned as +C the value of the FORTRAN expression -(LNIC+1+ICHAR(CHST(1:1))). +C +C The following common blocks contain variables which are required for +C the character-storage-and-retrieval scheme of AUTOGRAPH. +C + COMMON /AGCHR1/ LNIC,INCH(2,50),LNCA,INCA +C + COMMON /AGCHR2/ CHRA(2000) +C + CHARACTER*1 CHRA +C +C If the string is short enough, just embed it in a negative integer +C and return that value to the caller as the identifier of the string. +C + IF (LNCS.LE.1) THEN + IDCS=-(LNIC+1+ICHAR(CHST(1:1))) + RETURN + END IF +C +C Otherwise, the string must be stashed in CHRA and the negative of the +C index, in INCH, of its descriptor returned to the caller. Loop, on I, +C through the index of character strings. +C + DO 104 I=1,LNIC +C +C If the next entry in the index is zeroed, use it for the new string. +C + IF (INCH(1,I).EQ.0) THEN +C +C Zeroed entry found. Return the negative of its index to the user. +C + IDCS=-I +C +C If there isn't enough room for the character string at the end of the +C character-storage array, do some garbage-collecting, eliminating all +C strings of all-zero characters. +C + IF (LNCS.GT.LNCA-INCA) THEN + J=0 + K=0 + DO 102 L=1,INCA + IF (CHRA(L).EQ.CHAR(0)) THEN + IF (J.EQ.0) J=L + ELSE + IF (J.NE.0) THEN + DO 101 M=1,LNIC + IF (INCH(1,M).GT.K) INCH(1,M)=INCH(1,M)+J-L + 101 CONTINUE + J=0 + END IF + K=K+1 + CHRA(K)=CHRA(L) + END IF + 102 CONTINUE + INCA=K + END IF +C +C If there still isn't enough room for the character string at the end +C of the character-storage array, take an error exit. Otherwise, stash +C it and return. All-zero characters are changed to blanks. +C + IF (LNCS.GT.LNCA-INCA) GO TO 901 + INCH(1,I)=INCA+1 + INCH(2,I)=LNCS + DO 103 J=1,LNCS + INCA=INCA+1 + CHRA(INCA)=CHST(J:J) + IF (ICHAR(CHRA(INCA)).EQ.0) CHRA(INCA)=' ' + 103 CONTINUE + RETURN +C + END IF +C + 104 CONTINUE +C +C If no zeroed entry was found in the index of character strings, jump +C to log an error and quit. +C + GO TO 902 +C +C Error exits. +C + 901 CALL SETER ('AGSTCH - CHARACTER-STRING BUFFER OVERFLOW - SEE CONSU + +LTANT',18,2) +C + 902 CALL SETER ('AGSTCH - CHARACTER-STRING INDEX OVERFLOW - SEE CONSUL + +TANT',19,2) +C + END diff --git a/sys/gio/ncarutil/autograph/agstup.f b/sys/gio/ncarutil/autograph/agstup.f new file mode 100644 index 00000000..41a97674 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agstup.f @@ -0,0 +1,543 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGSTUP (XDRA,NVIX,IIVX,NEVX,IIEX, + + YDRA,NVIY,IIVY,NEVY,IIEY) +C + DIMENSION XDRA(1),YDRA(1) +C +C The routine AGSTUP is called to examine the parameter list, to provide +C default values for missing parameters, and to check for and cope with +C label overlap problems. +C +C The arguments describe the x and y data arrays to be used for the next +C graph. See the routine AGEXUS for a description of them. +C +C The following common block contains the AUTOGRAPH control parameters, +C all of which are real. If it is changed, all of AUTOGRAPH (especially +C the routine AGSCAN) must be examined for possible side effects. +C + COMMON /AGCONP/ QFRA,QSET,QROW,QIXY,QWND,QBAC , SVAL(2) , + + XLGF,XRGF,YBGF,YTGF , XLGD,XRGD,YBGD,YTGD , SOGD , + + XMIN,XMAX,QLUX,QOVX,QCEX,XLOW,XHGH , + + YMIN,YMAX,QLUY,QOVY,QCEY,YLOW,YHGH , + + QDAX(4),QSPA(4),PING(4),PINU(4),FUNS(4),QBTD(4), + + BASD(4),QMJD(4),QJDP(4),WMJL(4),WMJR(4),QMND(4), + + QNDP(4),WMNL(4),WMNR(4),QLTD(4),QLED(4),QLFD(4), + + QLOF(4),QLOS(4),DNLA(4),WCLM(4),WCLE(4) , + + QODP,QCDP,WOCD,WODQ,QDSH(26) , + + QDLB,QBIM,FLLB(10,8),QBAN , + + QLLN,TCLN,QNIM,FLLN(6,16),QNAN , + + XLGW,XRGW,YBGW,YTGW , XLUW,XRUW,YBUW,YTUW , + + XLCW,XRCW,YBCW,YTCW , WCWP,HCWP,SCWP , + + XBGA(4),YBGA(4),UBGA(4),XNDA(4),YNDA(4),UNDA(4), + + QBTP(4),BASE(4),QMNT(4),QLTP(4),QLEX(4),QLFL(4), + + QCIM(4),QCIE(4),RFNL(4),WNLL(4),WNLR(4),WNLB(4), + + WNLE(4),QLUA(4) , + + RBOX(6),DBOX(6,4),SBOX(6,4) +C +C The following common block contains other AUTOGRAPH variables, both +C real and integer, which are not control parameters. +C + COMMON /AGORIP/ SMRL , ISLD , MWCL,MWCM,MWCE,MDLA,MWCD,MWDQ , + + INIF +C +C Declare the block data routine external to force it to load. +C +C EXTERNAL AGDFLT +C +C Do statistics-gathering call. +C + LOGICAL Q8Q4 + SAVE Q8Q4 + DATA Q8Q4 /.TRUE./ + IF (Q8Q4) THEN + CALL Q8QST4('GRAPHX','AUTOGRAPH','AGSTUP','VERSION 07') + Q8Q4 = .FALSE. + ENDIF +C +C +NOAO - Block data replaced with run time initialization +C + call agdflt +C +C -NOAO +C If initialization has not yet been done, do it. +C + IF (INIF.EQ.0) THEN + CALL AGINIT + END IF +C +C Compute the width and height of the plotter frame. +C + CALL GETSI (IWFP,IHFP) + WOFP=2.**IWFP-1. + HOFP=2.**IHFP-1. +C +C Examine the get-limits-from-last-set-call parameter. +C + IF (ABS(QSET).EQ.1.) GO TO 141 +C + CALL GETSET (XLCW,XRCW,YBCW,YTCW,XMNT,XMXT,YMNT,YMXT,LILO) +C + QLUX=FLOAT((1-LILO)/2) + QLUY=FLOAT(MOD(1-LILO,2)) +C + IF (ABS(QSET).EQ.3.) GO TO 140 +C + XLGD=(XLCW-XLGF)/(XRGF-XLGF) + XRGD=(XRCW-XLGF)/(XRGF-XLGF) + YBGD=(YBCW-YBGF)/(YTGF-YBGF) + YTGD=(YTCW-YBGF)/(YTGF-YBGF) + SOGD=0. +C + IF (ABS(QSET).EQ.2.) GO TO 141 +C + 140 XMIN=AMIN1(XMNT,XMXT) + XMAX=AMAX1(XMNT,XMXT) + QOVX=0. + IF (XMNT.GT.XMXT) QOVX=1. + QCEX=0. +C + YMIN=AMIN1(YMNT,YMXT) + YMAX=AMAX1(YMNT,YMXT) + QOVY=0. + IF (YMNT.GT.YMXT) QOVY=1. + QCEY=0. +C + 141 CONTINUE +C +C Examine the graph-window parameters. +C + XLGF=AMAX1(0.,AMIN1(1.,XLGF)) + XRGF=AMAX1(0.,AMIN1(1.,XRGF)) + YBGF=AMAX1(0.,AMIN1(1.,YBGF)) + YTGF=AMAX1(0.,AMIN1(1.,YTGF)) +C + IF (XLGF.GE.XRGF.OR.YBGF.GE.YTGF) GO TO 901 +C +C Examine the grid-window parameters. +C + XLGD=AMAX1(0.,AMIN1(1.,XLGD)) + XRGD=AMAX1(0.,AMIN1(1.,XRGD)) + YBGD=AMAX1(0.,AMIN1(1.,YBGD)) + YTGD=AMAX1(0.,AMIN1(1.,YTGD)) +C + IF (XLGD.GE.XRGD.OR.YBGD.GE.YTGD) GO TO 902 +C +C Examine the user-window minima and maxima for special values. Compute +C tentative values of the user-window edge parameters. +C + QIXY=AMAX1(0.,AMIN1(1.,QIXY)) +C + IF (QIXY.NE.0.) GO TO 142 +C + CALL AGEXUS (SVAL,XMIN,XMAX,XLOW,XHGH, + + XDRA,NVIX,IIVX,NEVX,IIEX,XLUW,XRUW) + CALL AGEXUS (SVAL,YMIN,YMAX,YLOW,YHGH, + + YDRA,NVIY,IIVY,NEVY,IIEY,YBUW,YTUW) + GO TO 143 +C + 142 CALL AGEXUS (SVAL,XMIN,XMAX,XLOW,XHGH, + + YDRA,NVIY,IIVY,NEVY,IIEY,XLUW,XRUW) + CALL AGEXUS (SVAL,YMIN,YMAX,YLOW,YHGH, + + XDRA,NVIX,IIVX,NEVX,IIEX,YBUW,YTUW) +C + 143 CONTINUE +C +C Examine the user-window nice-value-at-ends parameters. INAX and INAY +C specify which axis has the nice values (if any). +C + QCEX=AMAX1(-1.,AMIN1(+1.,QCEX)) + INAX=IFIX(QCEX) + IF (INAX.NE.0) INAX=(INAX+7)/2 +C + QCEY=AMAX1(-1.,AMIN1(+1.,QCEY)) + INAY=IFIX(QCEY) + IF (INAY.NE.0) INAY=(INAY+3)/2 +C +C Examine the user-window linear-log flags. +C + QLUX=AMAX1(-1.,AMIN1(1.,QLUX)) + QLUY=AMAX1(-1.,AMIN1(1.,QLUY)) +C +C Examine the axis parameters. +C + QLUD=ABS(QLUY) + INAD=INAY + UMIN=YBUW + UMAX=YTUW + QMIN=YBUW + QMAX=YTUW +C + I=0 +C + 101 I=I+1 + IF (I.EQ.5) GO TO 104 +C + IF (I.EQ.3) THEN + QLUD=ABS(QLUX) + INAD=INAX + UMIN=XLUW + UMAX=XRUW + QMIN=XLUW + QMAX=XRUW + END IF +C + QDAX(I)=AMAX1(-1.,AMIN1(4.,QDAX(I))) + IF (QDAX(I).LE.0.) GO TO 102 + QLUA(I)=QLUD + QBTP(I)=QBTD(I) + IF (QBTD(I).EQ.SVAL(1).OR.QBTD(I).EQ.SVAL(2)) QBTP(I)=1.+QLUD + QBTP(I)=AMAX1(0.,AMIN1(3.,QBTP(I))) + IF (QBTD(I).EQ.SVAL(2)) QBTD(I)=QBTP(I) +C + CALL AGEXAX (I,SVAL,UMIN,UMAX,INAD-I,QLUD,FUNS(I),QBTP(I),BASD(I), + + BASE(I),QMJD(I),QMND(I),QMNT(I),QLTD(I),QLTP(I), + + QLED(I),QLEX(I),QLFD(I),QLFL(I),QMIN,QMAX) +C + QSPA(I)=AMAX1(0.,AMIN1(1.,QSPA(I))) + IF (QJDP(I).EQ.SVAL(1).OR.QJDP(I).EQ.SVAL(2)) QJDP(I)=65535. + IF (QNDP(I).EQ.SVAL(1).OR.QNDP(I).EQ.SVAL(2)) QNDP(I)=65535. +C + 102 IF (I.EQ.2) THEN + YBUW=QMIN + YTUW=QMAX + ELSE IF (I.EQ.4) THEN + XLUW=QMIN + XRUW=QMAX + END IF +C + GO TO 101 +C +C Examine the user-window min-max/max-min ordering parameters. Compute +C final values of the user-window edge parameters. +C + 104 QOVX=AMAX1(0.,AMIN1(1.,QOVX)) + IF (QOVX.EQ.0.) GO TO 105 + TEMP=XLUW + XLUW=XRUW + XRUW=TEMP +C + 105 QOVY=AMAX1(0.,AMIN1(1.,QOVY)) + IF (QOVY.EQ.0.) GO TO 106 + TEMP=YBUW + YBUW=YTUW + YTUW=TEMP +C +C Determine the exact size and shape of the curve window. +C + 106 XLGW=XLGF*WOFP + XRGW=XRGF*WOFP + YBGW=YBGF*HOFP + YTGW=YTGF*HOFP +C + XLCW=XLGW+XLGD*(XRGW-XLGW) + XRCW=XLGW+XRGD*(XRGW-XLGW) + YBCW=YBGW+YBGD*(YTGW-YBGW) + YTCW=YBGW+YTGD*(YTGW-YBGW) +C + WCWP=XRCW-XLCW + HCWP=YTCW-YBCW +C + ARWH=WCWP/HCWP +C + IF (SOGD) 107,115,108 +C + 107 DRWH=ABS(SOGD) + GO TO 111 +C + 108 DRWH=ABS((XRUW-XLUW)/(YTUW-YBUW)) + IF (SOGD-1.) 109,110,110 +C + 109 IF (DRWH.LT.SOGD.OR.(1./DRWH).LT.SOGD) GO TO 115 + GO TO 111 +C + 110 IF (DRWH.GT.SOGD.OR.(1./DRWH).GT.SOGD) DRWH=1. +C + 111 IF (DRWH-ARWH) 112,115,113 +C + 112 XLCW=XLCW+.5*(WCWP-HCWP*DRWH) + XRCW=XRCW-.5*(WCWP-HCWP*DRWH) + GO TO 114 +C + 113 YBCW=YBCW+.5*(HCWP-WCWP/DRWH) + YTCW=YTCW-.5*(HCWP-WCWP/DRWH) +C + 114 WCWP=XRCW-XLCW + HCWP=YTCW-YBCW +C + 115 SCWP=AMIN1(WCWP,HCWP) +C + XLGW=(XLGW-XLCW)/WCWP + XRGW=(XRGW-XLCW)/WCWP + YBGW=(YBGW-YBCW)/HCWP + YTGW=(YTGW-YBCW)/HCWP +C + XLCW=XLCW/WOFP + XRCW=XRCW/WOFP + YBCW=YBCW/HOFP + YTCW=YTCW/HOFP +C +C Make sure the number of dash patterns is in range. +C + QODP=AMAX1(-26.,AMIN1(+26.,QODP)) + IF (QODP.EQ.0.) QODP=-1. +C +C Examine the windowing parameter. +C + QWND=AMAX1(0.,AMIN1(1.,QWND)) +C +C Do a test run of the routine AGLBLS to find out how much space will be +C required for labels in each of the six label boxes. +C + QDLB=AMAX1(0.,AMIN1(2.,QDLB)) + IDLB=IFIX(QDLB) + LBIM=IFIX(QBIM) +C + CALL AGLBLS (-IDLB,WCWP,HCWP,FLLB,LBIM,FLLN,DBOX,SBOX,RBOX) +C +C Compute the desired and smallest-possible widths of the labels in +C boxes 1 and 2. +C + DWB1=AMAX1(0.,DBOX(1,2)-DBOX(1,1)) + SWB1=AMAX1(0.,SBOX(1,2)-SBOX(1,1)) + DWB2=AMAX1(0.,DBOX(2,2)-DBOX(2,1)) + SWB2=AMAX1(0.,SBOX(2,2)-SBOX(2,1)) +C +C Compute the desired and smallest-possible heights of the labels in +C boxes 3 and 4. +C + DHB3=AMAX1(0.,DBOX(3,4)-DBOX(3,3)) + SHB3=AMAX1(0.,SBOX(3,4)-SBOX(3,3)) + DHB4=AMAX1(0.,DBOX(4,4)-DBOX(4,3)) + SHB4=AMAX1(0.,SBOX(4,4)-SBOX(4,3)) +C +C Do test runs of AGAXIS for each of the four axes to see how much space +C will be required for numeric labels. +C + I=0 +C + 118 I=I+1 + IF (I.EQ.5) GO TO 128 +C + XYPI=FLOAT(1-MOD(I,2)) + IF (QDAX(I).EQ.0.) GO TO 121 + IF (PING(I).NE.SVAL(1)) XYPI=PING(I) +C + IF (I.GE.3) GO TO 119 +C + XYMN=XLGW + XYMX=XRGW + IF (PINU(I).EQ.SVAL(1)) GO TO 120 + XYPI=(PINU(I)-XLUW)/(XRUW-XLUW) + IF (QLUX.NE.0.) XYPI=(ALOG10(PINU(I))-ALOG10(XLUW))/ + + (ALOG10(XRUW)-ALOG10(XLUW)) + GO TO 120 +C + 119 XYMN=YBGW + XYMX=YTGW + IF (PINU(I).EQ.SVAL(1)) GO TO 120 + XYPI=(PINU(I)-YBUW)/(YTUW-YBUW) + IF (QLUY.NE.0.) XYPI=(ALOG10(PINU(I))-ALOG10(YBUW))/ + + (ALOG10(YTUW)-ALOG10(YBUW)) +C + 120 XYPI=AMAX1(XYMN,AMIN1(XYMX,XYPI)) +C + 121 GO TO (122,123,124,125) , I +C +C Left y axis. +C + 122 XBGA(1)=XYPI + YBGA(1)=0. + UBGA(1)=YBUW + XNDA(1)=XYPI + YNDA(1)=1. + UNDA(1)=YTUW + WNLL(1)=XYPI-XLGW-DWB1 + WNLR(1)=XRGW-XYPI-DWB2 + GO TO 126 +C +C Right y axis. +C + 123 XBGA(2)=XYPI + YBGA(2)=1. + UBGA(2)=YTUW + XNDA(2)=XYPI + YNDA(2)=0. + UNDA(2)=YBUW + WNLL(2)=XRGW-XYPI-DWB2 + WNLR(2)=XYPI-XLGW-DWB1 + GO TO 126 +C +C Bottom x axis. +C + 124 XBGA(3)=1. + YBGA(3)=XYPI + UBGA(3)=XRUW + XNDA(3)=0. + YNDA(3)=XYPI + UNDA(3)=XLUW + WNLL(3)=XYPI-YBGW-DHB3 + WNLR(3)=YTGW-XYPI-DHB4 + GO TO 126 +C +C Top x axis. +C + 125 XBGA(4)=0. + YBGA(4)=XYPI + UBGA(4)=XLUW + XNDA(4)=1. + YNDA(4)=XYPI + UNDA(4)=XRUW + WNLL(4)=YTGW-XYPI-DHB4 + WNLR(4)=XYPI-YBGW-DHB3 +C + 126 IF (QDAX(I).GT.0.) THEN + CALL AGAXIS (I,QDAX(I),QSPA(I),WCWP,HCWP,XBGA(I),YBGA(I), + + XNDA(I),YNDA(I),QLUA(I),UBGA(I),UNDA(I),FUNS(I), + + QBTP(I),BASE(I),QJDP(I),WMJL(I),WMJR(I),QMNT(I), + + QNDP(I),WMNL(I),WMNR(I),QLTP(I),QLEX(I),QLFL(I), + + QLOF(I),QLOS(I),DNLA(I),WCLM(I),WCLE(I),RFNL(I), + + QCIM(I),QCIE(I),WNLL(I),WNLR(I),10.,11.) + ELSE + WNLL(I)=0. + WNLR(I)=0. + END IF + GO TO 118 +C +C If no labels are to be drawn, AGSTUP is now done. +C + 128 IF (IDLB.EQ.0) GO TO 138 +C +C Check the label boxes, moving and/or shrinking them to prevent the +C labels in them from overlapping any portion of any axis. The labels +C on an axis may have to be moved, as well. +C +C Box 1 - to the left of the curve window. +C + IF (DBOX(1,2).GT.0.) GO TO 903 + DBOX(1,2)=AMIN1(0.,XBGA(1)-WNLL(1),XBGA(2)-WNLR(2)) + DBOX(1,1)=DBOX(1,2)-DWB1 + IF (DBOX(1,1).LT.XLGW) DBOX(1,1)=AMIN1(DBOX(1,2)-SWB1,XLGW) + IF (DBOX(1,1).GE.XLGW) GO TO 130 + DBOX(1,1)=XLGW + DBOX(1,2)=XLGW+SWB1 + TEMP=XBGA(1)-WNLL(1)-DBOX(1,2) + IF (TEMP.GE.0.) GO TO 129 + WNLL(1)=WNLL(1)+TEMP + WNLR(1)=WNLR(1)-TEMP + 129 TEMP=XBGA(2)-WNLR(2)-DBOX(1,2) + IF (TEMP.GE.0.) GO TO 130 + WNLL(2)=WNLL(2)-TEMP + WNLR(2)=WNLR(2)+TEMP +C +C Box 2 - to the right of the curve window. +C + 130 IF (DBOX(2,1).LT.1.) GO TO 904 + DBOX(2,1)=AMAX1(1.,XBGA(1)+WNLR(1),XBGA(2)+WNLL(2)) + DBOX(2,2)=DBOX(2,1)+DWB2 + IF (DBOX(2,2).GT.XRGW) DBOX(2,2)=AMAX1(DBOX(2,1)+SWB2,XRGW) + IF (DBOX(2,2).LE.XRGW) GO TO 132 + DBOX(2,1)=XRGW-SWB2 + DBOX(2,2)=XRGW + TEMP=XBGA(1)+WNLR(1)-DBOX(2,1) + IF (TEMP.LE.0.) GO TO 131 + WNLL(1)=WNLL(1)+TEMP + WNLR(1)=WNLR(1)-TEMP + 131 TEMP=XBGA(2)+WNLL(2)-DBOX(2,1) + IF (TEMP.LE.0.) GO TO 132 + WNLL(2)=WNLL(2)-TEMP + WNLR(2)=WNLR(2)+TEMP +C +C Box 3 - below the curve window. +C + 132 IF (DBOX(3,4).GT.0.) GO TO 905 + DBOX(3,4)=AMIN1(0.,YBGA(3)-WNLL(3),YBGA(4)-WNLR(4)) + DBOX(3,3)=DBOX(3,4)-DHB3 + IF (DBOX(3,3).LT.YBGW) DBOX(3,3)=AMIN1(DBOX(3,4)-SHB3,YBGW) + IF (DBOX(3,3).GE.YBGW) GO TO 134 + DBOX(3,3)=YBGW + DBOX(3,4)=YBGW+SHB3 + TEMP=YBGA(3)-WNLL(3)-DBOX(3,4) + IF (TEMP.GE.0.) GO TO 133 + WNLL(3)=WNLL(3)+TEMP + WNLR(3)=WNLR(3)-TEMP + 133 TEMP=YBGA(4)-WNLR(4)-DBOX(3,4) + IF (TEMP.GE.0.) GO TO 134 + WNLL(4)=WNLL(4)-TEMP + WNLR(4)=WNLR(4)+TEMP +C +C Box 4 - above the curve window. +C + 134 IF (DBOX(4,3).LT.1.) GO TO 906 + DBOX(4,3)=AMAX1(1.,YBGA(3)+WNLR(3),YBGA(4)+WNLL(4)) + DBOX(4,4)=DBOX(4,3)+DHB4 + IF (DBOX(4,4).GT.YTGW) DBOX(4,4)=AMAX1(DBOX(4,3)+SHB4,YTGW) + IF (DBOX(4,4).LE.YTGW) GO TO 136 + DBOX(4,3)=YTGW-SHB4 + DBOX(4,4)=YTGW + TEMP=YBGA(3)+WNLR(3)-DBOX(4,3) + IF (TEMP.LE.0.) GO TO 135 + WNLL(3)=WNLL(3)+TEMP + WNLR(3)=WNLR(3)-TEMP + 135 TEMP=YBGA(4)+WNLL(4)-DBOX(4,3) + IF (TEMP.LE.0.) GO TO 136 + WNLL(4)=WNLL(4)-TEMP + WNLR(4)=WNLR(4)+TEMP +C +C Box 5 - the curve window itself. +C + 136 IF (DBOX(5,1).LT.0..OR.DBOX(5,2).GT.1..OR. + + DBOX(5,3).LT.0..OR.DBOX(5,4).GT.1.) GO TO 907 +C + DBOX(5,1)=AMAX1(XLGW,XBGA(1)+WNLR(1)) + DBOX(5,2)=AMIN1(XRGW,XBGA(2)-WNLR(2)) + DBOX(5,3)=AMAX1(YBGW,YBGA(3)+WNLR(3)) + DBOX(5,4)=AMIN1(YTGW,YBGA(4)-WNLR(4)) +C +C Do a final check on all boxes for labels running outside the graph +C window. +C + DO 137 NBOX=1,6 + DBOX(NBOX,1)=AMAX1(XLGW,DBOX(NBOX,1)) + DBOX(NBOX,2)=AMIN1(XRGW,DBOX(NBOX,2)) + DBOX(NBOX,3)=AMAX1(YBGW,DBOX(NBOX,3)) + DBOX(NBOX,4)=AMIN1(YTGW,DBOX(NBOX,4)) + 137 CONTINUE +C +C Do a "SET" call for the user and return. +C + 138 CALL SET (XLCW,XRCW,YBCW,YTCW,XLUW,XRUW,YBUW,YTUW, + + 1+IABS(IFIX(QLUX))*2+IABS(IFIX(QLUY))) +C + RETURN +C +C Error exits. +C + 901 CALL SETER ('AGSTUP - GRAPH WINDOW IMPROPERLY SPECIFIED',20,2) +C + 902 CALL SETER ('AGSTUP - GRID WINDOW IMPROPERLY SPECIFIED',21,2) +C + 903 CALL SETER ('AGSTUP - LEFT LABELS IMPROPERLY SPECIFIED',22,2) +C + 904 CALL SETER ('AGSTUP - RIGHT LABELS IMPROPERLY SPECIFIED',23,2) +C + 905 CALL SETER ('AGSTUP - BOTTOM LABELS IMPROPERLY SPECIFIED',24,2) +C + 906 CALL SETER ('AGSTUP - TOP LABELS IMPROPERLY SPECIFIED',25,2) +C + 907 CALL SETER ('AGSTUP - INTERIOR LABELS IMPROPERLY SPECIFIED',26,2) +C + END diff --git a/sys/gio/ncarutil/autograph/agutol.f b/sys/gio/ncarutil/autograph/agutol.f new file mode 100644 index 00000000..02dbf64c --- /dev/null +++ b/sys/gio/ncarutil/autograph/agutol.f @@ -0,0 +1,49 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE AGUTOL (IAXS,FUNS,IDMA,VINP,VOTP) +C +C This routine is called to perform the mapping from the "user system" +C along an axis to the "label system" along that axis or vice-versa. It +C may be replaced by the user in order to create a desired graph. The +C arguments are as follows: +C +C -- IAXS is the index of the axis being drawn. Its value is 1, 2, 3, +C or 4, implying the left, right, bottom, or top axis, respectively. +C +C -- FUNS is the value of the parameter 'AXIS/s/FUNCTION.', which may be +C used to select the desired mapping function for axis IAXS. It is +C recommended that the default value (zero) be used to specify the +C identity mapping. A non-zero value may be integral (1., 2., etc.) +C and serve purely to select the code to be executed or it may be the +C value of a real parameter in the equations defining the mapping. +C +C -- IDMA specifies the direction of the mapping. A value greater than +C zero indicates that VINP is a value in the user system and that +C VOTP is to be a value in the label system, a value less than zero +C the opposite. +C +C -- VINP is an input value in one coordinate system along the axis. +C +C -- VOTP is an output value in the other coordinate system along the +C axis. +C +C The default routine simply defines the identity mapping for all axes. +C + VOTP=VINP +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/anotat.f b/sys/gio/ncarutil/autograph/anotat.f new file mode 100644 index 00000000..ed46025b --- /dev/null +++ b/sys/gio/ncarutil/autograph/anotat.f @@ -0,0 +1,63 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE ANOTAT (LABX,LABY,LBAC,LSET,NDSH,DSHL) +C + CHARACTER*(*) LABX,LABY,DSHL(*) +C +C The routine ANOTAT resets background annotation. +C +C Declare the type of the dash-pattern-parameter-name generator. +C + CHARACTER*16 AGDSHN +C +C Set up the x-axis label. +C + IF (ICHAR(LABX(1:1)).NE.0) THEN + CALL AGSETC ('LABE/NAME.', 'B') + CALL AGSETI ('LINE/NUMB.',-100) + CALL AGSETC ('LINE/TEXT.',LABX) + END IF +C +C Set up the y-axis label. +C + IF (ICHAR(LABY(1:1)).NE.0) THEN + CALL AGSETC ('LABE/NAME.', 'L') + CALL AGSETI ('LINE/NUMB.', 100) + CALL AGSETC ('LINE/TEXT.',LABY) + END IF +C +C Set up the background the user wants. +C + IF (LBAC.GT.0) CALL AGSETI ('BACK.',LBAC) +C +C Set the parameter ISET. +C + IF (LSET.NE.0) CALL AGSETI ('SET .',LSET) +C +C Set up the dash patterns the user wants. +C + IF (NDSH.NE.0) THEN + IDSH=MIN0(26,NDSH) + CALL AGSETI ('DASH/SELE.',IDSH) + IF (IDSH.LT.0) RETURN + DO 101 I=1,IDSH + CALL AGSETC (AGDSHN(I),DSHL(I)) + 101 CONTINUE + END IF +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/displa.f b/sys/gio/ncarutil/autograph/displa.f new file mode 100644 index 00000000..0749b29b --- /dev/null +++ b/sys/gio/ncarutil/autograph/displa.f @@ -0,0 +1,33 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE DISPLA (LFRA,LROW,LTYP) +C +C The subroutine DISPLA resets the parameters IFRA, IROW, and/or LLUX +C and LLUY. +C + IF (LFRA.NE.0) CALL AGSETI ('FRAM.', MAX0(1,MIN0(3,LFRA))) +C + IF (LROW.NE.0) CALL AGSETI ('ROW .',LROW) +C + IF (LTYP.EQ.0) RETURN +C + ITYP=MAX0(1,MIN0(4,LTYP)) + CALL AGSETI ('X/LOGA.', (1-ITYP)/2) + CALL AGSETI ('Y/LOGA.',MOD(1-ITYP,2)) +C + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/ezmxy.f b/sys/gio/ncarutil/autograph/ezmxy.f new file mode 100644 index 00000000..bc8f6352 --- /dev/null +++ b/sys/gio/ncarutil/autograph/ezmxy.f @@ -0,0 +1,67 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE EZMXY (XDRA,YDRA,IDXY,MANY,NPTS,LABG) +C + REAL XDRA(*),YDRA(*) +C + CHARACTER*(*) LABG +C +C The routine EZMXY draws many curves, each of them defined by points of +C the form (XDRA(I,J),YDRA(I,J)) or (XDRA(J,I),YDRA(J,I)) or, possibly, +C (XDRA(I),YDRA(I,J)) or (XDRA(I),YDRA(J,I)), for I = 1, 2, ... NPTS and +C for J = 1, 2, ... MANY. (YDRA is actually dimensioned IDXY by * .) +C +C Do statistics-gathering call. +C + LOGICAL Q8Q4 + SAVE Q8Q4 + DATA Q8Q4 /.TRUE./ + IF (Q8Q4) THEN + CALL Q8QST4('GRAPHX','AUTOGRAPH','EZMXY','VERSION 07') + Q8Q4 = .FALSE. + ENDIF +C +C +NOAO +C + call agdflt +C +C -NOAO + CALL AGGETI ('SET .',ISET) + CALL AGGETI ('FRAM.',IFRA) + CALL AGGETI ('DASH/SELE.',IDSH) +C + CALL AGEZSU (4,XDRA,YDRA,IDXY,MANY,NPTS,LABG,IIVX,IIEX,IIVY,IIEY) + CALL AGBACK +C + IF (ISET.LT.0) GO TO 102 +C + DO 101 I=1,MANY + INXD=1+(I-1)*IIVX + INYD=1+(I-1)*IIVY + KDSH=ISIGN(I,IDSH) + CALL AGCURV (XDRA(INXD),IIEX,YDRA(INYD),IIEY,NPTS,KDSH) + 101 CONTINUE +C + 102 IF (IFRA.EQ.1) CALL FRAME +C +C +NOAO +C + call initag +C +C -NOAO + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/ezmy.f b/sys/gio/ncarutil/autograph/ezmy.f new file mode 100644 index 00000000..e406465b --- /dev/null +++ b/sys/gio/ncarutil/autograph/ezmy.f @@ -0,0 +1,65 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE EZMY (YDRA,IDXY,MANY,NPTS,LABG) +C + REAL XDRA(1),YDRA(*) +C + CHARACTER*(*) LABG +C +C The routine EZMY draws many curves, each of them defined by points of +C the form (I,YDRA(I,J)) or (I,YDRA(J,I)), for I = 1, 2, ... NPTS and +C for J = 1, 2, ... MANY. (YDRA is actually dimensioned IDXY by * .) +C +C Do statistics-gathering call. +C + LOGICAL Q8Q4 + SAVE Q8Q4 + DATA Q8Q4 /.TRUE./ + IF (Q8Q4) THEN + CALL Q8QST4('GRAPHX','AUTOGRAPH','EZMY','VERSION 07') + Q8Q4 = .FALSE. + ENDIF +C +C +NOAO +C + call agdflt +C +C -NOAO + CALL AGGETI ('SET .',ISET) + CALL AGGETI ('FRAM.',IFRA) + CALL AGGETI ('DASH/SELE.',IDSH) +C + CALL AGEZSU (3,XDRA,YDRA,IDXY,MANY,NPTS,LABG,IIVX,IIEX,IIVY,IIEY) + CALL AGBACK +C + IF (ISET.LT.0) GO TO 102 +C + DO 101 I=1,MANY + INYD=1+(I-1)*IIVY + KDSH=ISIGN(I,IDSH) + CALL AGCURV (XDRA,0,YDRA(INYD),IIEY,NPTS,KDSH) + 101 CONTINUE +C + 102 IF (IFRA.EQ.1) CALL FRAME +C +C +NOAO +C + call initag +C +C -NOAO + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/ezxy.f b/sys/gio/ncarutil/autograph/ezxy.f new file mode 100644 index 00000000..e6ef3b5e --- /dev/null +++ b/sys/gio/ncarutil/autograph/ezxy.f @@ -0,0 +1,57 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE EZXY (XDRA,YDRA,NPTS,LABG) +C + REAL XDRA(*),YDRA(*) +C + CHARACTER*(*) LABG +C +C The routine EZXY draws one curve through the points (XDRA(I),YDRA(I)), +C for I = 1, 2, ... NPTS. +C +C Do statistics-gathering call. +C + LOGICAL Q8Q4 + SAVE Q8Q4 + DATA Q8Q4 /.TRUE./ + IF (Q8Q4) THEN + CALL Q8QST4('GRAPHX','AUTOGRAPH','EZXY','VERSION 07') + Q8Q4 = .FALSE. + ENDIF +C +C +NOAO +C + call agdflt +C +C -NOAO + CALL AGGETI ('SET .',ISET) + CALL AGGETI ('FRAM.',IFRA) +C + CALL AGEZSU (2,XDRA,YDRA,NPTS,1,NPTS,LABG,IIVX,IIEX,IIVY,IIEY) + CALL AGBACK +C + IF (ISET.GE.0) CALL AGCURV (XDRA,1,YDRA,1,NPTS,1) +C + IF (IFRA.EQ.1) CALL FRAME +C +C +NOAO +C + call initag +C +C -NOAO + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/ezy.f b/sys/gio/ncarutil/autograph/ezy.f new file mode 100644 index 00000000..3be54a03 --- /dev/null +++ b/sys/gio/ncarutil/autograph/ezy.f @@ -0,0 +1,57 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE EZY (YDRA,NPTS,LABG) +C + REAL XDRA(1),YDRA(*) +C + CHARACTER*(*) LABG +C +C The subroutine EZY draws one curve through the points (I,YDRA(I)), for +C I = 1, 2, ... NPTS. +C +C Do statistics-gathering call. +C + LOGICAL Q8Q4 + SAVE Q8Q4 + DATA Q8Q4 /.TRUE./ + IF (Q8Q4) THEN + CALL Q8QST4('GRAPHX','AUTOGRAPH','EZY','VERSION 07') + Q8Q4 = .FALSE. + ENDIF +C +C +NOAO +C + call agdflt +C +C -NOAO + CALL AGGETI ('SET .',ISET) + CALL AGGETI ('FRAM.',IFRA) +C + CALL AGEZSU (1,XDRA,YDRA,NPTS,1,NPTS,LABG,IIVX,IIEX,IIVY,IIEY) + CALL AGBACK +C + IF (ISET.GE.0) CALL AGCURV (XDRA,0,YDRA,1,NPTS,1) +C + IF (IFRA.EQ.1) CALL FRAME +C +C +NOAO +C + call initag +C +C -NOAO + RETURN +C + END diff --git a/sys/gio/ncarutil/autograph/idiot.f b/sys/gio/ncarutil/autograph/idiot.f new file mode 100644 index 00000000..0e2ce5e5 --- /dev/null +++ b/sys/gio/ncarutil/autograph/idiot.f @@ -0,0 +1,64 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + SUBROUTINE IDIOT (XDRA,YDRA,NPTS,LTYP,LDSH,LABX,LABY,LABG,LFRA) +C + REAL XDRA(*),YDRA(*) +C + INTEGER LDSH(*) +C + CHARACTER*(*) LABX,LABY,LABG +C + CHARACTER*16 AGBNCH +C +C This is an implementation of the routine from which AUTOGRAPH grew. +C It should work pretty much as the original did (if you can figure out +C what that was). +C +C Do statistics-gathering call. +C + LOGICAL Q8Q4 + SAVE Q8Q4 + DATA Q8Q4 /.TRUE./ + IF (Q8Q4) THEN + CALL Q8QST4('GRAPHX','AUTOGRAPH','IDIOT','VERSION 07') + Q8Q4 = .FALSE. + ENDIF +C +C +NOAO +C + call agdflt +C +C -NOAO + CALL ANOTAT (LABX,LABY,1,2-ISIGN(1,NPTS),1,AGBNCH(LDSH)) +C + CALL DISPLA (2-MAX0(-1,MIN0(1,LFRA)),1,LTYP) +C + CALL AGEZSU (5,XDRA,YDRA,IABS(NPTS),1,IABS(NPTS),LABG,IIVX,IIEX, + + IIVY,IIEY) + CALL AGBACK +C + CALL AGCURV (XDRA,1,YDRA,1,IABS(NPTS),1) +C + IF (LFRA.GT.0) CALL FRAME +C +C +NOAO +C + call plotit (0, 0, 2) + call initut +C +C -NOAO + RETURN + END diff --git a/sys/gio/ncarutil/autograph/mkpkg b/sys/gio/ncarutil/autograph/mkpkg new file mode 100644 index 00000000..8af0a0d4 --- /dev/null +++ b/sys/gio/ncarutil/autograph/mkpkg @@ -0,0 +1,62 @@ +# Make the NCAR AUTOGRAPH library. + +$checkout libncar.a lib$ +$update libncar.a +$checkin libncar.a lib$ +$exit + +libncar.a: + agdflt.f + agaxis.f + agback.f + agbnch.f + agchax.f + agchcu.f + agchil.f + agchnl.f + agctcs.f + agctko.f + agcurv.f + agdash.f + agdlch.f + agdshn.f + agexax.f + agexus.f + agezsu.f + agfpbn.f + agftol.f + aggetc.f + aggetf.f + aggeti.f + aggetp.f + aggtch.f + aginit.f + agkurv.f + aglbls.f + agmaxi.f + agmini.f + agnumb.f + agppid.f + agpwrt.f + agqurv.f + agrpch.f + agrstr.f + agsave.f + agscan.f + agsetc.f + agsetf.f + agseti.f + agsetp.f + agsrch.f + agstch.f + agstup.f + agutol.f + anotat.f + displa.f + ezmxy.f + ezmy.f + ezxy.f + ezy.f + idiot.f + pstr.x + ; diff --git a/sys/gio/ncarutil/autograph/pstr.x b/sys/gio/ncarutil/autograph/pstr.x new file mode 100644 index 00000000..a40c9fc1 --- /dev/null +++ b/sys/gio/ncarutil/autograph/pstr.x @@ -0,0 +1,14 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# PSTR -- Print a character string from a fortran program. The string is +# passed as an unpacked spp string, the result of f77upk in the calling +# program. PSTR is called by agppid.f in the autograph package. + +procedure pstr (spp_string) + +char spp_string[ARB] + +begin + call eprintf ("%s\n") + call pargstr (spp_string) +end |