← Back to branch summary

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

« back to all changes in this revision

Viewing changes to contrib/invent/libsrc/ifstar.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/invent/libsrc/ifstar.for
 
1
C @(#)ifstar.for        19.1 (ES0-DMD) 02/25/03 13:25:34
 
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+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
30
C
 
31
C
 
32
C
 
33
C-----------------------------------------------------------------------
 
34
      SUBROUTINE IFSTAR(IBUFS, SCA, LPXL, LSBP, IS ,
 
35
     &                  JS, MPRF, IPSF, FPSF, IOFF0,
 
36
     &                  IOFF, STAR, IOFFI)
 
37
      INTEGER   IBUFS(4)
 
38
      REAL      SCA
 
39
      INTEGER   LPXL
 
40
      INTEGER   LSBP
 
41
      INTEGER   IS
 
42
      INTEGER   JS
 
43
      INTEGER   MPRF
 
44
      INTEGER   IPSF(0:MPRF)
 
45
      REAL      FPSF(1)
 
46
      INTEGER   IOFF0
 
47
      INTEGER   IOFF
 
48
      LOGICAL   STAR
 
49
      INTEGER   IOFFI                    ! OUT: Corrections offset
 
50
C
 
51
      INTEGER   I , ICSP , IOF0 , ITMP , NADR , NOSP
 
52
      REAL      TEMP , TEMP1
 
53
      REAL      MSBP
 
54
C
 
55
C *** Check if standard star.
 
56
      IF ( (-LPXL) .GE. IBUFS(1)
 
57
     &                  .AND. (-LPXL) .GE. IBUFS(2)
 
58
     &                  .AND. LPXL .LE. IBUFS(3)
 
59
     &                  .AND. LPXL .LE. IBUFS(4) ) THEN
 
60
          STAR = .TRUE.
 
61
      ELSE
 
62
          STAR = .FALSE.
 
63
      ENDIF
 
64
C
 
65
      IF ( STAR ) THEN
 
66
          MSBP = 2 * LSBP + 1
 
67
C
 
68
C ***     NOSP - maximum number of standard stars.
 
69
C
 
70
          NOSP = IPSF(0)
 
71
C
 
72
C ***     Find offset to adresses of standard stars intensities.
 
73
C
 
74
          IOF0 = (5+NOSP) * IOFF +
 
75
     &           ( (LSBP+JS) * MSBP + LSBP + IS ) * NOSP
 
76
C
 
77
C ***     Calculate current number of this standard object.
 
78
C
 
79
          NADR = (LSBP+JS) * MSBP + LSBP + IS + 1 + NOSP
 
80
          ICSP = IPSF(NADR) + 1
 
81
          IF ( ICSP .GT. NOSP ) THEN
 
82
C
 
83
C ***         Look if present object is brighter than any
 
84
C ***         of previously recorded standard objects.
 
85
C
 
86
              TEMP = FPSF(IOF0+1) + 1.0
 
87
              ITMP = 0
 
88
              DO 40 I = 1 , NOSP
 
89
                  TEMP1 = FPSF(IOF0+I)
 
90
                  IF ( SCA .GT. TEMP1 ) THEN
 
91
                      IF ( TEMP1 .LT. TEMP ) THEN
 
92
                          TEMP = TEMP1
 
93
                          ITMP = I
 
94
                      ENDIF
 
95
                  ENDIF
 
96
   40         CONTINUE
 
97
              IF ( ITMP .GT. 0 .AND. ITMP .LE. NOSP ) THEN
 
98
C
 
99
C ***             Replace fainter object.
 
100
C
 
101
                  ICSP = ITMP
 
102
                  FPSF(IOF0+ICSP) = SCA
 
103
              ELSE
 
104
C
 
105
C ***             Is too faint.
 
106
C
 
107
                  STAR = .FALSE.
 
108
                  ICSP = ICSP - 1
 
109
              ENDIF
 
110
          ELSE
 
111
C
 
112
C ***         Add new standard star.
 
113
C
 
114
              IPSF(NADR) = ICSP
 
115
              FPSF(IOF0+ICSP) = SCA
 
116
          ENDIF
 
117
C
 
118
          IOFFI = IOFF0 + (4+ICSP) * IOFF
 
119
      ENDIF
 
120
C
 
121
      RETURN
 
122
C
 
123
      END
 
124
C