Initial commit

1 files changed, 415 insertions, 0 deletions

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