C @(#)nrdist.for 17.1.1.1 (ES0-DMD) 01/25/02 17:15:43 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 NRDIST version 1 820521 C A. Kruszewski ESO Garching C modified version 1.1 870303 C A. Kruszewski Obs. de Geneve C.PURPOSE C finds for a particular object out of a list of "M" objects C a nearest other object C.INPUT/OUTPUT C input arguments C L integer*4 number of a considered object on a list C L0 integer*4 offset to catalog buffer C L1 integer*4 last object in catalog buffer C LDIS integer*4 starting value C LSTP integer*4 array limits of regions C NREG integer*4 number of regions C NCAT integer*4 array integer parameters of objects C PMTR real*4 array array holding positions of objects C PRCT real*4 array catalog of profiles C NP integer*4 number of entries in buffers C output arguments C NCAT integer*4 array distance to the nearest other object C is stored in NCAT(3,L) C----------------------------------------------------------------------- SUBROUTINE NRDIST(L, L0, L1, LDIS, NREG, LSTP, NCAT, PMTR, PRCT) C IMPLICIT NONE INCLUDE 'MID_REL_INCL:INVENT.INC/NOLIST' C INTEGER NREG INTEGER L , L0 , L1 , LACT , LDIS , LSTP(0:4,0:NREG) , LTMP INTEGER NCAT(NIPAR,MAXCNT) , NCT(NIPAR) REAL PMTR(NRPAR,MAXCNT) , PRCT(0:MAXSUB,MAXCNT) REAL PMT(NRPAR) , PRC(0:NRPAR) LOGICAL DONE C DONE = .TRUE. LTMP = 3 * LDIS LACT = 0 10 CONTINUE IF ( .NOT. DONE ) GOTO 20 CALL GETLST( L , L0 , L1 , LTMP , NREG , LSTP , NCAT , & PMTR , PRCT , LACT , NCT , PMT , PRC , DONE ) IF ( DONE ) THEN LTMP = NINT( SQRT( FLOAT( (NCAT(1,L)-NCAT(1,LACT))**2 + & (NCAT(2,L)-NCAT(2,LACT))**2 ) ) ) ENDIF GOTO 10 20 CONTINUE NCAT(3,L) = LTMP C RETURN C END