path: root/sys/gio/ncarutil/autograph/agnumb.f

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