← Back to branch summary

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

« back to all changes in this revision

Viewing changes to contrib/invent/libsrc/rdcrin.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/rdcrin.for
 
1
C @(#)rdcrin.for        19.1 (ES0-DMD) 02/25/03 13:25:38
 
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.IDENTIFICATION
 
31
C  subroutine RDCRIN         version 1.1       831011
 
32
C  A. Kruszewski             ESO Garching
 
33
C.PURPOSE
 
34
C  reads descriptor "STARS" containing physical coordinates of
 
35
C  stars which are suitable for determining standard
 
36
C  point spread function, converts physical coordinates into
 
37
C  pixel coordinates and identifies these stars with detected
 
38
C  objects
 
39
C.INPUT/OUTPUT
 
40
C  input arguments
 
41
C  NCAT        integer*4 array   array holding integer data on
 
42
C                                objects, NCAT(1,*) is equal to
 
43
C                                X-pixel coordinate
 
44
C                                N(2,*) is Y-pixel coordinate
 
45
C  M           integer*4         number of objects
 
46
C  output arguments
 
47
C  NKK         integer*4 array   array holding identification numbers
 
48
C                                of identified objects
 
49
C  NSTS        integer*4         number of standard stars which are
 
50
C                                identified with objects
 
51
C-----------------------------------------------------------------------
 
52
      SUBROUTINE RDCRIN(IMF, NCAT, M, NKK, NSTS)
 
53
C
 
54
      IMPLICIT NONE
 
55
      INCLUDE 'MID_REL_INCL:INVENT.INC/NOLIST'
 
56
C
 
57
      INTEGER   IMF
 
58
      INTEGER   M
 
59
      INTEGER   NCAT(NIPAR,M)
 
60
      INTEGER   NKK(MPSF)
 
61
      INTEGER   NSTS
 
62
C
 
63
      INTEGER   ISTAT, IACT
 
64
      INTEGER   IC(MPSF)
 
65
      INTEGER   IDX, IDY, IDIS
 
66
      INTEGER   K, KK
 
67
      INTEGER   KUN, KNUL
 
68
      INTEGER   L
 
69
      INTEGER   NK(MPSF)
 
70
      INTEGER   NN, NSTR1, NSTR2
 
71
C
 
72
      REAL   STST(3*MPSF)
 
73
C
 
74
      DOUBLE PRECISION   START(2) , STEP(2)
 
75
C
 
76
C ******      Read descriptor STARS containing
 
77
C ******      coordinates of standard stars.
 
78
C
 
79
      CALL STDRDR( IMF , 'STARS' , 1 , 3*MPSF , IACT , STST , KUN ,
 
80
     &                                          KNUL , ISTAT )
 
81
C
 
82
C ******      Find number of standard stars.
 
83
C
 
84
      KK = IACT/3
 
85
C
 
86
C ******      Read descriptors START and STEP.
 
87
C
 
88
      CALL STDRDD( IMF , 'START' , 1 , 2 , IACT , START , KUN ,
 
89
     &                                          KNUL , ISTAT )
 
90
      CALL STDRDD( IMF , 'STEP' , 1 , 2 , IACT , STEP , KUN ,
 
91
     &                                          KNUL , ISTAT )
 
92
C
 
93
C ******      Perform identification of standard stars
 
94
C ******      with objects listed in array NCAT.
 
95
C
 
96
      DO 20 K = 1 , KK
 
97
          IC(K) = 0
 
98
          NK(K) = 0
 
99
          NSTR1 = NINT( (DBLE(STST(K*3-2))-START(1)) / STEP(1) ) + 1
 
100
          NSTR2 = NINT( (DBLE(STST(K*3-1))-START(2)) / STEP(2) ) + 1
 
101
          DO 10 L = 1 , M
 
102
            IDX = NSTR1 - NCAT(1,L)
 
103
            IDY = NSTR2 - NCAT(2,L)
 
104
            IDIS = IDX*IDX + IDY*IDY
 
105
            IF (IDIS.LT.9) THEN
 
106
                IC(K) = IC(K) + 1
 
107
                NK(K) = L
 
108
            ENDIF
 
109
   10          CONTINUE
 
110
   20      CONTINUE
 
111
C
 
112
C ******      Check if each standard star has been
 
113
C ******      identified with one and only one object.
 
114
C
 
115
      NN = 0
 
116
      DO 30 K = 1 , KK
 
117
          IF (IC(K).EQ.1) THEN
 
118
            NN = NN + 1
 
119
            NKK(NN) = NK(K)
 
120
          ENDIF
 
121
 
 
122
   30      CONTINUE
 
123
C
 
124
C ******      NSTS is a number of succesfully identified objects.
 
125
C
 
126
      NSTS   = NN
 
127
      IF (NSTS.LT.1) THEN
 
128
         CALL STTPUT(' No standard stars identified',ISTAT)
 
129
      ENDIF
 
130
C
 
131
      RETURN
 
132
C
 
133
      END