← Back to branch summary

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

« back to all changes in this revision

Viewing changes to contrib/romafot/libsrc/intsat.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/romafot/libsrc/intsat.for
 
1
C @(#)intsat.for        19.1 (ES0-DMD) 02/25/03 13:29:43
 
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
      SUBROUTINE INTSAT(MTS,NR,NC,NI,IST,NLI,KSAT)
 
30
C+++
 
31
C---
 
32
      IMPLICIT NONE
 
33
      INTEGER  NR
 
34
      INTEGER  NC
 
35
      INTEGER  MTS(NR,NC)
 
36
      INTEGER  NI
 
37
      INTEGER  IST(1)
 
38
      INTEGER  NLI
 
39
      INTEGER  KSAT
 
40
C
 
41
      INTEGER  I, K
 
42
C
 
43
      I = IST(NI)
 
44
      K = I-1
 
45
   20 CONTINUE
 
46
      IF (K.LT.1.OR.IABS(MTS(I,2)-MTS(K,2)).GE.2) THEN
 
47
         GO TO 10
 
48
      ENDIF
 
49
C
 
50
      IF (MTS(K,4).EQ.0) THEN
 
51
         IF (MTS(K,2).EQ.MTS(I,2)-1) THEN
 
52
           IF (MTS(K,3).GE.MTS(I,1).AND.MTS(I,3).GE.MTS(K,1)) THEN
 
53
             NLI      = NLI+1
 
54
             MTS(K,4) = 1
 
55
             IST(NLI) = K
 
56
           END IF
 
57
         END IF
 
58
      END IF
 
59
      K=K-1
 
60
      GO TO 20
 
61
C
 
62
   10 CONTINUE
 
63
      K = I+1
 
64
C
 
65
   30 CONTINUE
 
66
      IF (K.GT.KSAT.OR.IABS(MTS(K,2)-MTS(I,2)).GE.2) THEN
 
67
         GO TO 40
 
68
      ENDIF
 
69
C
 
70
      IF (MTS(K,4).EQ.0) THEN
 
71
         IF (MTS(K,2).EQ.MTS(I,2)+1) THEN
 
72
           IF (MTS(K,3).GE.MTS(I,1).AND.MTS(I,3).GE.MTS(K,1)) THEN
 
73
             NLI      = NLI+1
 
74
             MTS(K,4) = 1
 
75
             IST(NLI) = K
 
76
           END IF
 
77
         END IF
 
78
      END IF
 
79
      K=K+1
 
80
      GO TO 30
 
81
 
 
82
   40 CONTINUE
 
83
      RETURN
 
84
      END