← Back to branch summary

~ubuntu-branches/ubuntu/wily/eso-midas/wily-proposed

« back to all changes in this revision

Viewing changes to contrib/astromet/libsrc/mean.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/astromet/libsrc/mean.for
 
1
C @(#)mean.for  19.1 (ES0-DMD) 02/25/03 13:23:05
 
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 @(#)mean.for  19.1 (ESO-SDAG) 02/25/03 13:23:05
 
30
      SUBROUTINE MEAN(XTEMP,YTEMP,IX,XMEAN,YMEAN,NKICK,RESA,SIG) 
 
31
 
 
32
      IMPLICIT REAL*8 (A-H,O-Z), INTEGER*4 (I-N)
 
33
C
 
34
C MEAN COMPUTES MEAN VALUES OF (X,Y) MEASUREMENTS OF THE SAME OBJECT.
 
35
C IF THERE ARE MORE THAN 2 MEASUREMENTS, THE R.M.S. VALUES OF X, Y
 
36
C AND R (=SQRT(X**2+Y**2)) ARE ALSO RETURNED IN RESA(3).
 
37
C IF R.M.S. (R) IS LARGER THAN SIG, THEN THE (X,Y) WITH THE
 
38
C LARGEST RESIDUAL IS REMOVED. THIS PROCESS IS CONTINUED UNTIL
 
39
C R.M.S. (R) < SIG, OR IF THERE ARE ONLY 2 MEASUREMENTS LEFT.
 
40
C
 
41
C A REASONABLE VALUE IS SIG = 5.0 MICRONS
 
42
C
 
43
      DIMENSION XTEMP(20),YTEMP(20),RESA(3)
 
44
 
 
45
      NKICK = 0 
 
46
   10 RESX = 0
 
47
      RESY = 0
 
48
      RESD = 0
 
49
      XMEAN = 0 
 
50
      YMEAN = 0 
 
51
 
 
52
      DO 20 I = 1,IX
 
53
         XMEAN = XMEAN + XTEMP(I)
 
54
   20    YMEAN = YMEAN + YTEMP(I)
 
55
      XMEAN = XMEAN/IX
 
56
      YMEAN = YMEAN/IX
 
57
 
 
58
      IF(IX.LE.2) GO TO  60 
 
59
 
 
60
      DO 30 I=1,IX
 
61
         RESX = RESX+(XMEAN-XTEMP(I))**2 
 
62
         RESY = RESY+(YMEAN-YTEMP(I))**2 
 
63
   30    RESD = RESD+((XMEAN-XTEMP(I))**2+(YMEAN-YTEMP(I))**2) 
 
64
      RESX = SQRT(RESX/(IX**2-IX))
 
65
      RESY = SQRT(RESY/(IX**2-IX))
 
66
      RESD = SQRT(RESD/(IX**2-IX))
 
67
 
 
68
      IF(RESD.LT.SIG) GO TO  60 
 
69
 
 
70
      DIFF = 0
 
71
 
 
72
C
 
73
C NOW FIND THE WORST (X,Y) AND REMOVE IT
 
74
C
 
75
      DO 40 I=1,IX
 
76
         DIF = SQRT((XMEAN-XTEMP(I))**2+(YMEAN-YTEMP(I))**2) 
 
77
         IF(DIF.LT.DIFF) GO TO 40
 
78
         IKICK = I 
 
79
         DIFF = DIF
 
80
   40    CONTINUE
 
81
 
 
82
C
 
83
C CLOSE THE RANKS
 
84
C
 
85
      DO 50 I=IKICK,IX
 
86
         XTEMP(I) = XTEMP(I+1) 
 
87
   50    YTEMP(I) = YTEMP(I+1) 
 
88
      IX = IX-1 
 
89
      NKICK = NKICK + 1 
 
90
      GO TO 10
 
91
 
 
92
 
 
93
C The End
 
94
   60 RESA(1) = RESX
 
95
      RESA(2) = RESY
 
96
      RESA(3) = RESD
 
97
      RETURN
 
98
      END 
 
99
 
 
100
 
 
101
 
 
102
 
 
103