C @(#)edist.for 17.1.1.1 (ES0-DMD) 01/25/02 17:16:38 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 C C C Determine standardized distances. C C C C To call: CALL DIST(N,M,DATA,A,W1,W2) where C C C C C C N, M : integer dimensions of ... C C DATA : input data. C C A : distances matrix (dimensions N by N). C C W1,W2 : real vectors of dimension N. C C C C F. Murtagh, ST-ECF/ESA/ESO, Garching-bei-Muenchen, January 1986. C C C C-------------------------------------------------------------------------C SUBROUTINE DIST(N,M,DATA,A,W1,W2) INTEGER N,M REAL DATA(N,M), A(N,N), W1(N), W2(N) C CALL DST(N,M,DATA,W1,W2,A) C RETURN END C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C C C C Determine inter-row distances. C C First determine the means, storing in WORK1. C C C C-------------------------------------------------------------------------C SUBROUTINE DST(N,M,DATA,WORK1,WORK2,OUT,ISTAT) INTEGER N,M,ISTAT,I1,J,I2 REAL DATA(N,M), OUT(N,N), WORK1(N), WORK2(N) REAL EPS DATA EPS/1.E-10/ C DO 100 I1 = 1, N-1 OUT(I1,I1) = 1.0 DO 90 I2 = I1+1, N OUT(I1,I2) = 0.0 DO 80 J = 1, M OUT(I1,I2) = OUT(I1,I2) + (DATA(I1,J)-DATA(I2,J))**2 80 CONTINUE OUT(I1,I2) = OUT(I1,I2)/FLOAT(M) OUT(I2,I1) = OUT(I1,I2) 90 CONTINUE 100 CONTINUE OUT(N,N) = 1.0 C RETURN END