diff options
Diffstat (limited to 'sys/gio/ncarutil/autograph/agnumb.f')
| -rw-r--r-- | sys/gio/ncarutil/autograph/agnumb.f | 491 |
1 files changed, 491 insertions, 0 deletions
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 |