CTITLESCALE -- LOGIC ASSOCIATES PACKAGE - SCALE DATA TO FIT AXIS 00010002 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR UNKNOWN 00020001 CA DESIGNER UNKNOWN 00030001 CA LANGUAGE FORTRAN 00040001 CA SYSTEM IBM AND CRAY 00050001 CA WRITTEN UNKNOWN 00060001 C REVISED 01-24-86 ESN. FOR CRAY COMPATABILITY. 00070001 C REVISED XX-XX-XX III. ... 00080001 CA 00090001 CA 00100001 CA CALL SCALE (ARRAY, AXLEN, NPTS, INCR) 00110001 CA 00120001 CA 00130001 CAEND 00140001 SUBROUTINE SCALE(ARRAY,AXLEN,NPTS,INCR) 00150001 C 00160001 DIMENSION ARRAY(1),TSCALE(6) 00170001 C 00180001 DATA TSCALE/1.0,2.0,4.0,5.0,8.0,10.0/ 00190001 C 00200001 C 00210001 C FIND MINIMUM AND MAXIMUM VALUES 00220001 C 00230001 ISTEP = IABS(INCR) 00240001 IEND = ISTEP*(NPTS - 1) + 1 00250001 IF (ISTEP .LE. 0) ISTEP = 1 00260001 ISTART = ISTEP + 1 00270001 XMIN = ARRAY(1) 00280001 XMAX = XMIN 00290001 DO 40 I = ISTART,IEND,ISTEP 00300001 IF (ARRAY(I) .LT. XMIN) XMIN = ARRAY(I) 00310001 IF (ARRAY(I) .GT. XMAX) XMAX = ARRAY(I) 00320001 40 CONTINUE 00330001 XMID = 0.5*(XMIN + XMAX) 00340001 C 00350001 C DETERMINE A TRIAL SCALE 00360001 C 00370001 N10 = 0 00380001 DELTA = (XMAX - XMIN)/AXLEN 00390001 IF (DELTA .NE. 0.0) GO TO 80 00400001 DELTA = 2.0*ABS(XMIN/AXLEN) 00410001 IF (DELTA .NE. 0.0) GO TO 80 00420001 ISCALE = 1 00430001 GO TO 200 00440001 80 IF (DELTA .GE. 1.0) GO TO 100 00450001 N10 = N10 - 1 00460001 DELTA = 10.0*DELTA 00470001 GO TO 80 00480001 100 IF (DELTA .LE. 10.0) GO TO 120 00490001 N10 = N10 + 1 00500001 DELTA = DELTA/10.0 00510001 GO TO 100 00520001 120 DO 140 ISCALE = 1,6,1 00530001 IF (DELTA .LE. TSCALE(ISCALE)) GO TO 200 00540001 140 CONTINUE 00550001 C 00560001 C CALCULATE BEGINNING AND ENDING OF AXIS 00570001 C 00580001 200 DELTA = TSCALE(ISCALE)*10.0**N10 00590001 EPS = 0.001*DELTA 00600001 RANGE = DELTA*AXLEN 00610001 RANG2 = 0.5*RANGE 00620001 IF (INCR) 280,260,260 00630001 260 TEMP = XMID - RANG2 00640001 IF (TEMP*XMIN .LE. 0.0) TEMP = 0.0 00650001 IMIN = IFIX(TEMP/DELTA + SIGN(0.5,TEMP)) 00660001 270 XSAVE = DELTA*FLOAT(IMIN) 00670001 X1 = XSAVE - EPS 00680001 IF (X1 .LE. XMIN) GO TO 275 00690001 IMIN = IMIN - 1 00700001 GO TO 270 00710001 275 X2 = XSAVE + RANGE + EPS 00720001 GO TO 300 00730001 280 TEMP = XMID + RANG2 00740001 IF (TEMP*XMAX .LE. 0.0) TEMP = 0.0 00750001 IMAX = IFIX(TEMP/DELTA + SIGN(0.5,TEMP)) 00760001 290 XSAVE = DELTA*FLOAT(IMAX) 00770001 X2 = XSAVE + EPS 00780001 IF (X2 .GE. XMAX) GO TO 295 00790001 IMAX = IMAX + 1 00800001 GO TO 290 00810001 295 X1 = XSAVE - RANGE - EPS 00820001 DELTA = - DELTA 00830001 C 00840001 C CHECK THAT DATA FITS WITHIN AXIS PROPERLY 00850001 C 00860001 300 IF ((X1 .LE. XMIN) .AND. (X2 .GE. XMAX)) GO TO 400 00870001 ISCALE = ISCALE + 1 00880001 IF (ISCALE .LE. 6) GO TO 200 00890001 ISCALE = 2 00900001 N10 = N10 + 1 00910001 GO TO 200 00920001 C 00930001 C STORE SCALE FACTORS AND RETURN TO CALLER 00940001 C 00950001 400 IEND = IEND + ISTEP 00960001 ARRAY(IEND) = XSAVE 00970001 IEND = IEND + ISTEP 00980001 ARRAY(IEND) = DELTA 00990001 RETURN 01000001 C 01010001 END 01020001