← Back to branch summary

~ubuntu-branches/debian/jessie/eso-midas/jessie

« back to all changes in this revision

Viewing changes to contrib/pepsys/libsrc/round.for

  • Committer: Package Import Robot
  • Author(s): Ole Streicher
  • Date: 2014-04-22 14:44:58 UTC
  • Revision ID: package-import@ubuntu.com-20140422144458-okiwi1assxkkiz39
Tags: upstream-13.09pl1.2+dfsg
Import upstream version 13.09pl1.2+dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
contrib/pepsys/libsrc/round.for
 
1
C @(#)round.for 19.1 (ES0-DMD) 02/25/03 13:28:48
 
2
C===========================================================================
 
3
C Copyright (C) 1995 European Southern Observatory (ESO)
 
4
C
 
5
C This program is free software; you can redistribute it and/or 
 
6
C modify it under the terms of the GNU General Public License as 
 
7
C published by the Free Software Foundation; either version 2 of 
 
8
C the License, or (at your option) any later version.
 
9
C
 
10
C This program is distributed in the hope that it will be useful,
 
11
C but WITHOUT ANY WARRANTY; without even the implied warranty of
 
12
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
13
C GNU General Public License for more details.
 
14
C
 
15
C You should have received a copy of the GNU General Public 
 
16
C License along with this program; if not, write to the Free 
 
17
C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
 
18
C MA 02139, USA.
 
19
C
 
20
C Corresponding concerning ESO-MIDAS should be addressed as follows:
 
21
C       Internet e-mail: midas@eso.org
 
22
C       Postal address: European Southern Observatory
 
23
C                       Data Management Division 
 
24
C                       Karl-Schwarzschild-Strasse 2
 
25
C                       D 85748 Garching bei Muenchen 
 
26
C                       GERMANY
 
27
C===========================================================================
 
28
C
 
29
C  @(#)round.for        19.1  (ESO-IPG)  02/25/03  13:28:48
 
30
      SUBROUTINE ROUND(XMIN,XMAX,NCELLS,DELTA,INT,SCALE)
 
31
C
 
32
C       Copyright (C) Andrew T. Young, 1990
 
33
C
 
34
C                           SPACING IN (X , CELLS)
 
35
C
 
36
C  PICKS ROUND NUMBERS FOR GRAPH LIMITS.            23 AUG 1985
 
37
C
 
38
C
 
39
      IMPLICIT NONE
 
40
C
 
41
      INTEGER NCELLS, INT, INTS, LOGS, I
 
42
      REAL XMIN, XMAX, DELTA, SCALE, RECIPS, DELS, RANGE, FNM1, PEAK,
 
43
     1         WIDTH, FULL, BOT, TOP
 
44
C
 
45
      DIMENSION RECIPS(10),INTS(10),DELS(10)
 
46
        INTEGER*4 MINTIC
 
47
C
 
48
      DATA RECIPS/5.,4.,3.,2.5,2.,1.5,1.2,1.,.8,.6/
 
49
C                                                      CELLS/UNIT.
 
50
      DATA INTS / 5, 4, 3,  5, 4,  3,  6, 5,  4, 3/
 
51
C                                                      CELLS/TICK.
 
52
      DATA DELS / 1.,1.,1., 2.,2., 2., 5.,5., 5.,5./
 
53
C                                                      UNITS/TICK.
 
54
C
 
55
      RANGE=XMAX-XMIN
 
56
      FNM1=NCELLS-1
 
57
C   IS ZERO INCLUDED?
 
58
      IF(XMIN*XMAX.LE.0.) GO TO 20
 
59
C  NO.  SHOULD IT BE?
 
60
      IF(RANGE.LT.0.) GO TO 6
 
61
C
 
62
C  HERE FOR NORMAL PLOT.
 
63
      IF(XMIN.GT.0.) GO TO 3
 
64
C    ZERO AT TOP, ALL NEG.VALUES.
 
65
      IF(XMAX/XMIN.GT.0.2) GO TO 20
 
66
    2 XMAX=0.
 
67
      GO TO 5
 
68
C    ZERO AT BOTTOM; NORMAL (ALL +.)
 
69
    3 IF(XMAX/XMIN.LT.5.) GO TO 20
 
70
    4 XMIN=0.
 
71
    5 RANGE=XMAX-XMIN
 
72
      GO TO 20
 
73
C
 
74
C  INVERTED PLOT.
 
75
    6 IF(XMIN.GT.0.) GO TO 8
 
76
C    ALL NEG.,ZERO AT BOTTOM.
 
77
      IF(XMAX/XMIN.GT.5.) GO TO 4
 
78
      GO TO 20
 
79
C    ALL +, ZERO AT TOP.
 
80
    8 IF(XMAX/XMIN.LT.0.2) GO TO 2
 
81
C
 
82
C  FIND SCALING.
 
83
C
 
84
   20 LOGS=LOG10(ABS(RANGE)/FNM1)-98.3
 
85
C    ENSURE MULTIPLES .GT.1
 
86
      SCALE=10.**(LOGS+98)
 
87
   21 PEAK=ABS(RANGE)/SCALE
 
88
C    PEAK IS RANGE IN SCALE UNITS.
 
89
      WIDTH=PEAK/FNM1
 
90
C    WIDTH OF ONE CELL.
 
91
      DO 22 I=1,10
 
92
      IF(RECIPS(I)*WIDTH.LE.1.) GO TO 25
 
93
   22 CONTINUE
 
94
   23 SCALE=SCALE*10.
 
95
      GO TO 21
 
96
C
 
97
   25 DELTA=SIGN(DELS(I),RANGE)
 
98
      INT=INTS(I)
 
99
      FULL=FNM1/RECIPS(I)
 
100
C    FULL IS IN SCALE UNITS.
 
101
C
 
102
C  TEST BOTH ENDS FOR CLEARANCE.
 
103
C
 
104
      MINTIC=XMIN/(SCALE*DELS(I)) + 1.D8
 
105
      MINTIC=MINTIC-100000000
 
106
      IF(RANGE.LT.0. .AND. MINTIC*DELS(I)*SCALE.NE.XMIN)MINTIC=MINTIC+1
 
107
      BOT=(MINTIC)*DELS(I)
 
108
      IF((RANGE.GT.0. .AND. BOT.LE.XMIN/SCALE) .OR.
 
109
     1 (RANGE.LT.0. .AND. BOT.GE.XMIN/SCALE)) GO TO 28
 
110
C    NEEDS MORE ROOM...
 
111
   27 I=I+1
 
112
      IF(I-10) 25,25,23
 
113
C
 
114
C  CHECK TOP.
 
115
C
 
116
   28  IF(RANGE.GT.0.)THEN
 
117
      TOP=FULL+BOT
 
118
      IF(TOP.LT.XMAX/SCALE) GO TO 27
 
119
       ELSE
 
120
      TOP=BOT-FULL
 
121
      IF(TOP.GT.XMAX/SCALE) GO TO 27
 
122
       END IF
 
123
      XMAX=TOP*SCALE
 
124
      XMIN=BOT*SCALE
 
125
      RETURN
 
126
C
 
127
      END