C @(#)rdcrin.for 17.1.1.1 (ES0-DMD) 01/25/02 17:15:44 C=========================================================================== C Copyright (C) 1995 European Southern Observatory (ESO) C C This program is free software; you can redistribute it and/or C modify it under the terms of the GNU General Public License as C published by the Free Software Foundation; either version 2 of C the License, or (at your option) any later version. C C This program is distributed in the hope that it will be useful, C but WITHOUT ANY WARRANTY; without even the implied warranty of C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the C GNU General Public License for more details. C C You should have received a copy of the GNU General Public C License along with this program; if not, write to the Free C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, C MA 02139, USA. C C Corresponding concerning ESO-MIDAS should be addressed as follows: C Internet e-mail: midas@eso.org C Postal address: European Southern Observatory C Data Management Division C Karl-Schwarzschild-Strasse 2 C D 85748 Garching bei Muenchen C GERMANY C=========================================================================== C C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C.IDENTIFICATION C subroutine RDCRIN version 1.1 831011 C A. Kruszewski ESO Garching C.PURPOSE C reads descriptor "STARS" containing physical coordinates of C stars which are suitable for determining standard C point spread function, converts physical coordinates into C pixel coordinates and identifies these stars with detected C objects C.INPUT/OUTPUT C input arguments C NCAT integer*4 array array holding integer data on C objects, NCAT(1,*) is equal to C X-pixel coordinate C N(2,*) is Y-pixel coordinate C M integer*4 number of objects C output arguments C NKK integer*4 array array holding identification numbers C of identified objects C NSTS integer*4 number of standard stars which are C identified with objects C----------------------------------------------------------------------- SUBROUTINE RDCRIN(IMF, NCAT, M, NKK, NSTS) C IMPLICIT NONE INCLUDE 'MID_REL_INCL:INVENT.INC/NOLIST' C INTEGER IMF INTEGER M INTEGER NCAT(NIPAR,M) INTEGER NKK(MPSF) INTEGER NSTS C INTEGER ISTAT, IACT INTEGER IC(MPSF) INTEGER IDX, IDY, IDIS INTEGER K, KK INTEGER KUN, KNUL INTEGER L INTEGER NK(MPSF) INTEGER NN, NSTR1, NSTR2 C REAL STST(3*MPSF) C DOUBLE PRECISION START(2) , STEP(2) C C ****** Read descriptor STARS containing C ****** coordinates of standard stars. C CALL STDRDR( IMF , 'STARS' , 1 , 3*MPSF , IACT , STST , KUN , & KNUL , ISTAT ) C C ****** Find number of standard stars. C KK = IACT/3 C C ****** Read descriptors START and STEP. C CALL STDRDD( IMF , 'START' , 1 , 2 , IACT , START , KUN , & KNUL , ISTAT ) CALL STDRDD( IMF , 'STEP' , 1 , 2 , IACT , STEP , KUN , & KNUL , ISTAT ) C C ****** Perform identification of standard stars C ****** with objects listed in array NCAT. C DO 20 K = 1 , KK IC(K) = 0 NK(K) = 0 NSTR1 = NINT( (DBLE(STST(K*3-2))-START(1)) / STEP(1) ) + 1 NSTR2 = NINT( (DBLE(STST(K*3-1))-START(2)) / STEP(2) ) + 1 DO 10 L = 1 , M IDX = NSTR1 - NCAT(1,L) IDY = NSTR2 - NCAT(2,L) IDIS = IDX*IDX + IDY*IDY IF (IDIS.LT.9) THEN IC(K) = IC(K) + 1 NK(K) = L ENDIF 10 CONTINUE 20 CONTINUE C C ****** Check if each standard star has been C ****** identified with one and only one object. C NN = 0 DO 30 K = 1 , KK IF (IC(K).EQ.1) THEN NN = NN + 1 NKK(NN) = NK(K) ENDIF 30 CONTINUE C C ****** NSTS is a number of succesfully identified objects. C NSTS = NN IF (NSTS.LT.1) THEN CALL STTPUT(' No standard stars identified',ISTAT) ENDIF C RETURN C END