C @(#)round.for 17.1.1.1 (ES0-DMD) 01/25/02 17:17:18 C=========================================================================== C Copyright (C) 1995 European Southern Observatory (ESO) C C This program is free software; you can redistribute it and/or C modify it under the terms of the GNU General Public License as C published by the Free Software Foundation; either version 2 of C the License, or (at your option) any later version. C C This program is distributed in the hope that it will be useful, C but WITHOUT ANY WARRANTY; without even the implied warranty of C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the C GNU General Public License for more details. C C You should have received a copy of the GNU General Public C License along with this program; if not, write to the Free C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, C MA 02139, USA. C C Corresponding concerning ESO-MIDAS should be addressed as follows: C Internet e-mail: midas@eso.org C Postal address: European Southern Observatory C Data Management Division C Karl-Schwarzschild-Strasse 2 C D 85748 Garching bei Muenchen C GERMANY C=========================================================================== C C @(#)round.for 17.1.1.1 (ESO-IPG) 01/25/02 17:17:18 SUBROUTINE ROUND(XMIN,XMAX,NCELLS,DELTA,INT,SCALE) C C Copyright (C) Andrew T. Young, 1990 C C SPACING IN (X , CELLS) C C PICKS ROUND NUMBERS FOR GRAPH LIMITS. 23 AUG 1985 C C IMPLICIT NONE C INTEGER NCELLS, INT, INTS, LOGS, I REAL XMIN, XMAX, DELTA, SCALE, RECIPS, DELS, RANGE, FNM1, PEAK, 1 WIDTH, FULL, BOT, TOP C DIMENSION RECIPS(10),INTS(10),DELS(10) INTEGER*4 MINTIC C DATA RECIPS/5.,4.,3.,2.5,2.,1.5,1.2,1.,.8,.6/ C CELLS/UNIT. DATA INTS / 5, 4, 3, 5, 4, 3, 6, 5, 4, 3/ C CELLS/TICK. DATA DELS / 1.,1.,1., 2.,2., 2., 5.,5., 5.,5./ C UNITS/TICK. C RANGE=XMAX-XMIN FNM1=NCELLS-1 C IS ZERO INCLUDED? IF(XMIN*XMAX.LE.0.) GO TO 20 C NO. SHOULD IT BE? IF(RANGE.LT.0.) GO TO 6 C C HERE FOR NORMAL PLOT. IF(XMIN.GT.0.) GO TO 3 C ZERO AT TOP, ALL NEG.VALUES. IF(XMAX/XMIN.GT.0.2) GO TO 20 2 XMAX=0. GO TO 5 C ZERO AT BOTTOM; NORMAL (ALL +.) 3 IF(XMAX/XMIN.LT.5.) GO TO 20 4 XMIN=0. 5 RANGE=XMAX-XMIN GO TO 20 C C INVERTED PLOT. 6 IF(XMIN.GT.0.) GO TO 8 C ALL NEG.,ZERO AT BOTTOM. IF(XMAX/XMIN.GT.5.) GO TO 4 GO TO 20 C ALL +, ZERO AT TOP. 8 IF(XMAX/XMIN.LT.0.2) GO TO 2 C C FIND SCALING. C 20 LOGS=LOG10(ABS(RANGE)/FNM1)-98.3 C ENSURE MULTIPLES .GT.1 SCALE=10.**(LOGS+98) 21 PEAK=ABS(RANGE)/SCALE C PEAK IS RANGE IN SCALE UNITS. WIDTH=PEAK/FNM1 C WIDTH OF ONE CELL. DO 22 I=1,10 IF(RECIPS(I)*WIDTH.LE.1.) GO TO 25 22 CONTINUE 23 SCALE=SCALE*10. GO TO 21 C 25 DELTA=SIGN(DELS(I),RANGE) INT=INTS(I) FULL=FNM1/RECIPS(I) C FULL IS IN SCALE UNITS. C C TEST BOTH ENDS FOR CLEARANCE. C MINTIC=XMIN/(SCALE*DELS(I)) + 1.D8 MINTIC=MINTIC-100000000 IF(RANGE.LT.0. .AND. MINTIC*DELS(I)*SCALE.NE.XMIN)MINTIC=MINTIC+1 BOT=(MINTIC)*DELS(I) IF((RANGE.GT.0. .AND. BOT.LE.XMIN/SCALE) .OR. 1 (RANGE.LT.0. .AND. BOT.GE.XMIN/SCALE)) GO TO 28 C NEEDS MORE ROOM... 27 I=I+1 IF(I-10) 25,25,23 C C CHECK TOP. C 28 IF(RANGE.GT.0.)THEN TOP=FULL+BOT IF(TOP.LT.XMAX/SCALE) GO TO 27 ELSE TOP=BOT-FULL IF(TOP.GT.XMAX/SCALE) GO TO 27 END IF XMAX=TOP*SCALE XMIN=BOT*SCALE RETURN C END