Initial commit

1 files changed, 616 insertions, 0 deletions

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