← Back to branch summary

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

« back to all changes in this revision

Viewing changes to contrib/invent/libsrc/updtl.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/updtl.for
 
1
C @(#)updtl.for 19.1 (ES0-DMD) 02/25/03 13:25:40
 
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 UPDTL( MCAT , NL , NN , M )
 
35
C
 
36
      IMPLICIT NONE
 
37
C
 
38
      INTEGER   ISTAT
 
39
      INTEGER   NL
 
40
      INTEGER   M , M3 , M4
 
41
C     INTEGER   M1 , M2 
 
42
      INTEGER   MB , MCAT(4,NL) , MM3 , MR , MS
 
43
C     INTEGER   MX1 , MX2
 
44
      INTEGER   MX3 , MX4 , MXX4
 
45
C     INTEGER   MY1 , MY2
 
46
      INTEGER   MY3 , MY4 , MYY4
 
47
      INTEGER   NN , NNB , NXB
 
48
C     REAL      B1 , B2, BX1 , BX2 , BY1 , BY2
 
49
C
 
50
      M3 = 0
 
51
      M4 = 0
 
52
      MX4 = 0
 
53
      MY4 = 0
 
54
      MS = M - MOD( M-1 , NL ) - 1
 
55
      IF (MS .GE. NL) THEN
 
56
         CALL STTPUT('*** FATAL: Internal buffer overflow; ',ISTAT)
 
57
         CALL STTPUT
 
58
     +   ('    Please, restrict search to smaller subframe',ISTAT)
 
59
         CALL STTPUT
 
60
     +   ('    or modify parameter setup fro detection',ISTAT)
 
61
         CALL STSEPI
 
62
      ENDIF
 
63
 
 
64
      MB = M - MS
 
65
      IF ( MB .EQ. 0 ) THEN
 
66
          MS = MS - NL
 
67
          MB = NL
 
68
     
 
69
      ENDIF
 
70
      MM3 = MCAT(3,MB)
 
71
C
 
72
C ******      Read neighbour parameters.
 
73
C
 
74
      IF ( NN .GT. MS ) THEN
 
75
          NNB = MOD( NN-1 , NL ) + 1
 
76
          M3 = MCAT(3,NNB)
 
77
          M4 = MCAT(4,NNB)
 
78
c      ELSE
 
79
c          READ ( ISF , REC=NN ) M1 , M2 , M3 , M4 , B1 , B2
 
80
      ENDIF
 
81
      MR = 0
 
82
C
 
83
C ******      Four out of five cases will be considered.
 
84
C
 
85
      IF ( M3 . EQ. 0 .AND. MM3 .EQ. 0 ) THEN
 
86
C
 
87
C ******          Detection is single and neighbour is single.
 
88
C
 
89
          M3 = NN
 
90
          MM3 = NN
 
91
          M4 = M
 
92
          MR = 1
 
93
      ELSE IF ( M3 .EQ. 0 .AND. MM3 .NE. 0 ) THEN 
 
94
C
 
95
C ******          Detection is multiple and neighbour is single.
 
96
C
 
97
          IF ( MM3 .GT. MS ) THEN
 
98
            NXB = MOD( MM3-1 , NL ) + 1
 
99
            MX4 = MCAT( 4 , NXB )
 
100
c          ELSE
 
101
c            READ ( ISF , REC=MM3 ) MX1 , MX2 , MX3 , MX4 , BX1 , BX2
 
102
               ENDIF
 
103
          M4 = MX4
 
104
          MX4 = NN
 
105
          M3 = MM3
 
106
          IF ( MM3 .GT. MS ) THEN
 
107
            MCAT( 4 , NXB ) = MX4
 
108
c          ELSE
 
109
c            WRITE ( ISF , REC=MM3 ) MX1, MX2, MX3, MX4, BX1, BX2
 
110
               ENDIF
 
111
          MR = 1
 
112
      ELSE IF ( M3 .NE. 0 .AND. MM3 .EQ. 0 ) THEN
 
113
C
 
114
C ******          Detection is single, neighbour is multiple.
 
115
C
 
116
          MM3 = M3
 
117
          MX4 = M4
 
118
          MXX4 = M4
 
119
          IF ( M4 .EQ. 0 ) THEN
 
120
            M4 = M
 
121
            MR = 1
 
122
          ENDIF
 
123
   10          CONTINUE
 
124
          IF ( MXX4 .GT. MS ) THEN
 
125
            NXB = MOD ( MXX4-1 , NL ) + 1
 
126
            MX4 = MCAT(4,NXB)
 
127
c          ELSE IF ( MXX4 .GT. 0 ) THEN
 
128
c            READ ( ISF , REC=MXX4 ) MX1, MX2, MX3, MX4, BX1, BX2       
 
129
          ENDIF
 
130
          IF ( MX4 .NE. 0 ) THEN
 
131
            MXX4 = MX4
 
132
            GOTO 10
 
133
          ENDIF
 
134
          MX4 = M
 
135
          IF ( MXX4 .GT. MS ) THEN
 
136
            NXB = MOD( MXX4-1 , NL ) + 1
 
137
            MCAT(4,NXB) = MX4
 
138
c          ELSE IF ( MXX4 .GT. 0 ) THEN
 
139
c            WRITE ( ISF , REC=MXX4 ) MX1, MX2, MX3, MX4, BX1, BX2
 
140
          ENDIF
 
141
      ELSE IF ( M3 .NE. 0 .AND. MM3 .NE. 0 .AND. M3 .NE. MM3 ) THEN
 
142
C
 
143
C ******            Detection is multiple, neighbour is multiple.
 
144
C ******            They belong to different objects.
 
145
C
 
146
          MY3 = MM3
 
147
          IF ( MY3 .GT. MS ) THEN
 
148
            NXB = MOD( MY3-1 , NL ) + 1
 
149
            MY4 = MCAT( 4 , NXB )
 
150
c          ELSE
 
151
c            READ ( ISF , REC=MY3 ) MY1, MY2, MY3, MY4, BY1, BY2
 
152
          ENDIF
 
153
          MYY4 = MY4
 
154
          MX3 = M3
 
155
          IF ( MX3 .GT. MS ) THEN
 
156
            NXB = MOD( MX3-1 , NL ) + 1
 
157
            MX4 = MCAT( 4 , NXB )
 
158
c          ELSE
 
159
c            READ ( ISF , REC=MX3 ) MX1, MX2, MX3, MX4, BX1, BX2
 
160
          ENDIF
 
161
          MY4 = MX3
 
162
          MX3 = MY3
 
163
          IF ( MY3 . GT. MS ) THEN
 
164
            NXB = MOD( MY3-1 , NL ) + 1
 
165
            MCAT( 4 , NXB ) = MY4
 
166
c          ELSE
 
167
c            WRITE ( ISF , REC=MY3 ) MY1, MY2, MY3, MY4, BY1, BY2
 
168
          ENDIF
 
169
          IF ( MY4 .GT. MS ) THEN
 
170
            NXB = MOD( MY4-1 , NL ) + 1
 
171
            MCAT ( 3 , NXB ) = MX3
 
172
c          ELSE
 
173
c            WRITE ( ISF , REC=MY4 ) MX1, MX2, MX3, MX4, BX1, BX2
 
174
          ENDIF
 
175
          MXX4 = MX4
 
176
  20          CONTINUE
 
177
            IF ( MXX4 .GT. MS ) THEN
 
178
            NXB = MOD ( MXX4-1 , NL ) + 1
 
179
            MX4 = MCAT( 4 , NXB )
 
180
c          ELSE IF ( MXX4 .GT. 0 ) THEN
 
181
c            READ ( ISF , REC=MXX4 ) MX1, MX2, MX3, MX4, BX1, BX2
 
182
          ENDIF
 
183
          IF ( MX4 .NE. 0 ) THEN
 
184
            MX3 = MY3
 
185
            IF ( MXX4 .GT. MS ) THEN
 
186
                NXB = MOD( MXX4-1 , NL ) + 1
 
187
                MCAT( 3 , NXB ) = MX3
 
188
c            ELSE
 
189
c                READ ( ISF , REC=MXX4 ) MX1,MX2,MX3,MX4,BX1,BX2
 
190
                 ENDIF
 
191
            MXX4 = MX4
 
192
            GOTO 20
 
193
          ENDIF
 
194
          MX3 = MY3
 
195
          MX4 = MYY4
 
196
          IF ( MXX4 .GT. MS ) THEN
 
197
            NXB = MOD( MXX4-1 , NL ) + 1
 
198
            MCAT(3,NXB) = MX3
 
199
            MCAT(4,NXB) = MX4
 
200
c          ELSE IF ( MXX4 .GT. 0 ) THEN
 
201
c            WRITE ( ISF , REC=MXX4 ) MX1, MX2, MX3, MX4, BX1, BX2
 
202
          ENDIF
 
203
      ENDIF
 
204
      IF ( MR .EQ. 1 ) THEN
 
205
          IF ( NN .GT. MS ) THEN
 
206
            NXB = MOD( NN-1 , NL ) + 1
 
207
            MCAT(3,NXB) = M3
 
208
            MCAT(4,NXB) = M4
 
209
c          ELSE
 
210
c            WRITE ( ISF , REC=NN ) M1 , M2 , M3 , M4 , B1 , B2
 
211
          ENDIF
 
212
      ENDIF
 
213
      MCAT(3,MB) = MM3
 
214
C
 
215
      RETURN
 
216
C
 
217
      END
 
218