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