SUBROUTINE GAXTIC(MSGUN,YMIN,YMAX,MXNMJR,NMJR,PMJR,LBL,LLBL,NMNR) C This routine determines tick marks and labels for axis C labeling. If this works as well as it ought to, credit should C go to Dave Kennison who condescended to give me a copy of CPNUMB C (renamed here to GNUMB) from CONPACK, Version 3. Dec 89. C INPUTS: C MSGUN = Fortran unit number to print any error diagnostics C YMIN = Smallest value to plot C YMAX = Biggest value to plot. If YMAX = YMIN, then YMIN C and YMAX will be changed. If YMAX < YMIN, inverted C scale is assumed; e.g., for a Y-axis, the biggest C tick label value would be on the bottom. C MXNMJR = Maximum number of labelled ticks allowed (array C dimension of PMJR and LBL). C RETURNS: C NMJR = Number of computed major tick marks. C PMJR = Fractional positions (domain: 0. -> 1.) of computed C tick marks which are to be labelled. C LBL = Labels for major ticks. USER should anticipate C up to MXNMJR labels of maximum length 14 characters C Error diagnotics will be generated. C LLBL = Number of assigned characters in corresponding LBL. C NMNR = Number of unlabelled ticks to be inserted between C major (labelled) ticks. C Declarations for formal arguments: DIMENSION PMJR(MXNMJR) , LLBL(MXNMJR) CHARACTER*(*) LBL(MXNMJR) C Local declarations: PARAMETER (NSTEP=3) DIMENSION TSTP(NSTEP) , NMINR (NSTEP) SAVE TSTP,NMINR DATA TSTP / 1., 2., 5./ DATA NMINR/ 4 , 1 , 4 / C Labelling constraints: C - Logarithmic scaling is not considered. C - Ymin may be less than smallest labelled tick mark. C - Ymax may be greater than largest labelled tick mark. C - MXNMJR is expected to be reasonable, i.e., more than 15 C labels becomes crowded; moreover, this scheme will require C extending the values of i another decade if MXNMJR exceeds C 200; but I have an error trap at 50. (See logic after C statement label 200 for definition of i.) IF(MXNMJR .GT. 50 .OR. MXNMJR .LT. 2)GO TO 9100 C The following formula is used to describe label intervals; C it says the number of labelled tick intervals is less than C or equal to the range: C C (ndy)(step)(10**m) <= R C C where ndy = number of label intervals; 0 < ndy < MXNMJR. C step = 1,2, or 5; a nice label interval. C m = an integer. MXNDY = MXNMJR - 1 RMXNDY = REAL( MXNDY ) R = YMAX - YMIN ISGN = 1 SGN = 1. IF(R .LT. 0.)THEN R = -R ISGN = -1 SGN = -1. ENDIF IF(R .EQ. 0.)THEN C Have a constant field to plot; so change Ymin and Ymax to one C order of magnitude less/more than current value. M = 0 IF(YMIN .NE. 0.)M = INT( LOG10( ABS(YMIN) ) ) - 1 DY = 10.**M OYMN = YMIN OYMX = YMAX YMIN = YMIN - DY YMAX = YMAX + DY WRITE(MSGUN,9200)OYMN,OYMX,YMIN,YMAX R = YMAX - YMIN ENDIF C Determine m as the next integer above the minimum possible C value. Note: log R - log(MXNDY*5) =< m =< log R. So unless C MXNDY is huge, m can only be one or two integers. Find the C smallest m here (after statement 100 the next m will be used): TSTM = LOG10( R / ( RMXNDY*TSTP(NSTEP) ) ) M = INT( TSTM ) IF( TSTM - REAL(M) .GT. 0.) M = M + 1 C Find step and dy by trial until error. Since most labels C possible is preferred, use ndy = MXNDY and increment step C to make new test dy values until MXNDY * dy >= range: RDT = R/10.**M DO 100 I=1,NSTEP IF( RMXNDY*TSTP(I) .GE. RDT )GO TO 200 100 CONTINUE C Must try the next integer for m: M = M + 1 RDT = RDT/10. DO 150 I=1,NSTEP IF( RMXNDY*TSTP(I) .GE. RDT )GO TO 200 150 CONTINUE STOP 200 STEP = TSTP(I) NMNR = NMINR(I) DY = STEP * 10.**M C Find smallest label value by finding an integer, i, such that C (i-1)(dy) < Ymin & (i)(dy) >= Ymin; i.e., i >= Ymin/dy SML = YMIN IF(ISGN .EQ. -1)SML = YMAX SDY = SML / DY IF(SDY .GE. 0.)THEN RI = REAL( INT( SDY + 0.99999999) ) ELSE RI = REAL( INT( SDY ) ) ENDIF YS = RI*DY IF( YS-DY .EQ. SML )YS = SML C Find exact ndy and biggest label value. This could not be done C precisely until Ys was established because there may be up to C 2dy discrepancy between Ymax-Ymin and Yb-Ys. BIG = YMAX IF(ISGN .EQ. -1)BIG = YMIN CK = BIG - YS DO 250 I=MXNDY,1,-1 IF( REAL(I)*DY .LE. CK )GO TO 300 250 CONTINUE 300 NDY = I NMJR = NDY + 1 YB = YS + REAL(NDY) * DY C Determine the format of labels to be built; see comments at C beginning of gnumb for parameters description. IF(DY .GT. 1.E4 .OR. R .GT. 1.E6 .OR. ABS(YB) .GT. 1.E5 .OR. + (YS .NE. 0. .AND. ABS(YS) .LT. 1.E-5) )THEN C Use exponential form for labels. Use difference between C largest and smallest label value scaled by minimum power of C ten in labels to determine how many mantissa digits to display YDT = (YB-YS) / 10.**M IF(YDT .LE. 99.9)THEN NDGD = 3 LMSD = M+1 ELSEIF(YDT .LE. 999.9)THEN NDGD = 4 LMSD = M+2 ELSE NDGD = 3 LMSD =-10000 ENDIF IEXP =-1 IOMA = 0 IODP = 0 IF(STEP .EQ. 1.)THEN C Maybe no mantissa is needed since dy is a power of ten. C Must also check to see if a label is a power of ten: IF(YS .EQ. 0.)THEN IOMA = 1 IODP = 1 ELSEIF( AMOD(LOG10(ABS(YS)),1.) .LT. 0.001 )THEN IOMA = 1 IODP = 1 ENDIF ENDIF IOTZ = 0 ELSE C Use non-exponential form; labels will be in range +/- .00001 C to 100,000. Determine LMSD, the left most significant digit, C based apon the larger of log(Ys) and log(Yb). (See GNUMB for C definition of LMSD). YSL = 0. IF(YS .NE. 0.)YSL = LOG10( ABS(YS) ) IF(YSL .GE. 0.)THEN IYSL = INT(YSL) ELSE IYSL = INT(YSL) - 1 ENDIF YBL = 0. IF(YB .NE. 0.)YBL = LOG10( ABS(YB) ) IF(YBL .GE. 0.)THEN IYBL = INT(YBL) ELSE IYBL = INT(YBL) - 1 ENDIF LMSD = MAX (IYSL,IYBL) NDGD = LMSD - M + 1 IEXP = 6 IOMA = 0 IODP = 0 IF(AMOD(DY,1.) .LT. 0.01 .AND. AMOD(YS,1.) .LT. 0.01) IODP = 1 IOTZ = 0 ENDIF C Build the labels and their positions LMAX = LEN(LBL(1)) Y1 = YS IF(ISGN .EQ. -1)Y1 = YB YI = Y1 - SGN*DY DO 1000 I=1,NMJR YI = YI + SGN*DY CALL GNUMB (YI ,NDGD,LMSD,IEXP, 2 ,'x','10**',' ',1,4,0, + IOMA,IODP,IOTZ,LBL(I),LLBL(I),NDGS,IEVA) IF(LLBL(I) .GT. LMAX )WRITE(MSGUN,9300)LMAX,LLBL(I) 1000 PMJR(I) = SGN*(YI-YMIN) / R RETURN C Error trap diagnostics: 9100 WRITE(MSGUN,'('' GAXTIC: MXNMJR is unreasonable! The maximum'', + '' number of labelled Y-axis tick'',/, + '' marks should be a small positive '', + ''integer, not'',I15)')MXNMJR STOP 9200 FORMAT(' GAXTIC: Warning, changed YMIN and YMAX',/, + ' from:',1P2E11.4,/, + ' to:', 2E11.4) 9300 FORMAT(' GAXTIC: Warning, truncated an axis label. Length ', + 'provided = ',I10,/, + ' Lengt', + 'h needed = ',I10) END