C @(#)tdscale.for 17.1.1.1 (ES0-DMD) 01/25/02 17:47:17 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++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C.COPYRIGHT: Copyright (c) 1987 European Southern Observatory, C all rights reserved C C.VERSION: 1.0 ESO-FORTRAN Conversion, AA 18:30 - 11 DEC 1987 C C.LANGUAGE: F77+ESOext C C.AUTHOR: J.D.PONZ C C.IDENTIFICATION TDSCALE.FOR C.KEYWORDS TABLE, APPLICATIONS C.ENVIRONMENT MIDAS C.PURPOSE C FINDS NICE LIMITS, DISTANCE BETWEEN TICS AND NUMBER OF TIC MARKS C FOR PLOTTING AND OTHER DISPLAY PURPOSES. C C C------------------------------------------------------------------ SUBROUTINE TDSCAL(DMIN,DMAX,SCAL,XLOW,XUPP,ID,DTIC,NLAB) IMPLICIT NONE REAL DMIN ! IN : minimum value REAL DMAX ! IN : maximum value REAL SCAL ! IN : scaling factor REAL XLOW ! OUT: mantisa of lower limit REAL XUPP ! OUT: mantisa of upper limit INTEGER ID ! OUT: exponent of XLOW and XUPP REAL DTIC ! OUT: distance between tic marks INTEGER NLAB ! OUT : number of tic marks C REAL DELTA,XMIN,XMAX,XDIF REAL OFFSET,SCALE,POTFAC REAL RLMIN,RLMAX INTEGER LMIN,LMAX,LDIF DATA DELTA/0.00001/ C NLAB = -1 XMIN = MIN(DMIN,DMAX) XMAX = MAX(DMIN,DMAX) SCALE = SCAL IF (DMIN.GT.DMAX) SCALE = -SCALE IF (XMIN.EQ.XMAX .OR. SCALE.EQ.0.) RETURN XDIF = XMAX - XMIN OFFSET = XDIF/ABS(SCALE*2.0) - 0.5*XDIF XMIN = XMIN - OFFSET XMAX = XMAX + OFFSET POTFAC = ALOG10(XDIF/2.0) IF (POTFAC.LT.0.) POTFAC = POTFAC - 1.0 + DELTA ID = INT(POTFAC) POTFAC = 10.0**ID RLMIN = XMIN/POTFAC IF (RLMIN.LT.0.) RLMIN = RLMIN - 1.0 + DELTA LMIN = INT(RLMIN) RLMAX = XMAX/POTFAC + 1.0 - DELTA IF (RLMAX.LT.0.) RLMAX = RLMAX - 1.0 + DELTA LMAX = INT(RLMAX) LDIF = LMAX - LMIN IF (LDIF.GT.5) GO TO 10 DTIC = 0.2 NLAB = 5 GO TO 30 10 IF (LDIF.GT.10) GO TO 20 IF (LMIN.LT.0) LMIN = LMIN - 1 LMIN = (LMIN/2)*2 IF (LMAX.LT.0) LMAX = LMAX - 1 LMAX = (LMAX/2+1)*2 DTIC = 0.5 NLAB = 4 GO TO 30 20 IF (LMIN.LT.0) LMIN = LMIN - 4 LMIN = INT(LMIN/5)*5 IF (LMAX.LT.0) LMAX = LMAX - 4 LMAX = INT((LMAX+4)/5)*5 DTIC = 1.0 NLAB = 5 30 IF (SCALE.LT.0) GO TO 40 XLOW = LMIN - DTIC XUPP = LMAX + DTIC DTIC = POTFAC*DTIC RETURN 40 CONTINUE XLOW = LMAX + DTIC XUPP = LMIN - DTIC DTIC = -POTFAC*DTIC RETURN END