C @(#)seesbr.for 17.1.1.1 (ES0-DMD) 01/25/02 17:16:39 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.IDENTIFICATION: C SEECL VERSION 1 85.01.21 C F.MURTAGH ST-ECF, MUNICH. C C.KEYWORDS: C APPLICATIONS, STATISTICS, CLUSTERING. C C.PURPOSE: C GIVEN A HIERARCHIC CLUSTERING, DESCRIBED AS A SEQUENCE C OF AGGLOMERATIONS, DERIVE THE ASSIGNMENTS INTO CLUSTERS C FOR THE TOP 8 LEVELS OF THE HIERARCHY. C PREPARE ALSO THE REQUIRED DATA FOR REPRESENTING THE C DENDROGRAM OF THIS TOP PART OF THE HIERARCHY. C C.ALGORITHM: C C.INPUT/OUTPUT: C PARAMETERS: C IA, IB, CRIT : VECTORS OF DIM. N DEFINING THE AGGLOMERATIONS; C HVALS : USED INTERNALLY ONLY; C ICLASS : ARRAY OF CLUSTER ASSIGNMENTS; C IORDER, CRITVAL, HEIGHT : VECTORS DESCRIBING THE DENDROGRAM. C *** NOTE *** VARIABLE TYPE IJKLMN CONVENTION FOLLOWED. C C--------------------------------------------------------------- C SUBROUTINE SEECL(N,IA,IB,CRIT,ICLASS,HVALS,IORDER,CRITVAL,HEIGHT) C INTEGER I,J,K,N,LOC,ICL,ILEV,LEVEL,NCL,ISTAT INTEGER NOR20,ICLASS(N,8) INTEGER IA(N),IB(N),HVALS(9),IORDER(9),HEIGHT(9) REAL CRIT(N),CRITVAL(9) CHARACTER*80 LINE C C C PICK OUT THE CLUSTERS WHICH THE N OBJECTS BELONG TO, C AT LEVELS N-2, N-3, ... N-8 OF THE HIERARCHY. C THE CLUSTERS ARE IDENTIFIED BY THE LOWEST SEQ. NO. OF C THEIR MEMBERS. C THERE ARE 2, 3, ... 9 CLUSTERS, RESPECTIVELY, FOR THE C ABOVE LEVELS OF THE HIERARCHY. HVALS(1)=1 HVALS(2)=IB(N-1) LOC=3 DO 59 I=N-2,N-9,-1 DO 52 J=1,LOC-1 IF (IA(I).EQ.HVALS(J)) GOTO 54 52 CONTINUE HVALS(LOC)=IA(I) LOC=LOC+1 54 CONTINUE DO 56 J=1,LOC-1 IF (IB(I).EQ.HVALS(J)) GOTO 58 56 CONTINUE HVALS(LOC)=IB(I) LOC=LOC+1 58 CONTINUE 59 CONTINUE C C DO 400 LEVEL=N-9,N-2 DO 200 I=1,N ICL=I DO 100 ILEV=1,LEVEL 100 IF (IB(ILEV).EQ.ICL) ICL=IA(ILEV) NCL=N-LEVEL ICLASS(I,NCL-1)=ICL 200 CONTINUE 400 CONTINUE C C DO 120 I=1,N DO 120 J=1,8 DO 110 K=2,9 IF (ICLASS(I,J).NE.HVALS(K)) GOTO 110 ICLASS(I,J)=K GOTO 120 110 CONTINUE 120 CONTINUE C C LINE = ' Assignments for 2-class to 9-class partitions follow.' CALL STTPUT(LINE,ISTAT) LINE = ' (See output table for full set of assignments.)' CALL STTPUT(LINE,ISTAT) LINE = ' ' CALL STTPUT(LINE,ISTAT) WRITE (LINE,450) CALL STTPUT(LINE,ISTAT) 450 FORMAT(4X,' SEQ NOS 2CL 3CL 4CL 5CL 6CL 7CL 8CL 9CL') WRITE (LINE,470) CALL STTPUT(LINE,ISTAT) 470 FORMAT(4X,' ------- --- --- --- --- --- --- --- --- ----') NOR20 = MIN0(N,20) DO 500 I=1,NOR20 WRITE (LINE,600) I,(ICLASS(I,J),J=1,8) CALL STTPUT(LINE,ISTAT) 600 FORMAT(I11,8I4) 500 CONTINUE C C C DETERMINE AN ORDERING OF THE 9 CLUSTERS (AT LEVEL N-8) C FOR LATER REPRESENTATION OF THE DENDROGRAM. C THESE ARE STORED IN "IORDER". C DETERMINE THE ASSOCIATED ORDERING OF THE CRITERION VALUES C (STORED IN "CRITVAL") FOR THE VERTICAL LINES IN THE DENDROGRAM. C THE ORDINAL VALUES OF THESE CRITERION VALUES MAY BE USED IN C PREFERENCE, AND THESE ARE STORED IN "HEIGHT". C FINALLY, NOTE THAT THE 9 CLUSTERS ARE RENAMED SO THAT THEY C HAVE SEQ. NOS. 1 TO 9. IORDER(1)=IA(N-1) IORDER(2)=IB(N-1) CRITVAL(1)=0.0 CRITVAL(2)=CRIT(N-1) HEIGHT(1)=9 HEIGHT(2)=8 LOC=2 DO 700 I=N-2,N-8,-1 DO 650 J=1,LOC IF (IA(I).EQ.IORDER(J)) THEN C SHIFT RIGHTWARDS AND INSERT IB(I) BESIDE IORDER(J): DO 630 K=LOC+1,J+1,-1 IORDER(K)=IORDER(K-1) CRITVAL(K)=CRITVAL(K-1) HEIGHT(K)=HEIGHT(K-1) 630 CONTINUE IORDER(J+1)=IB(I) CRITVAL(J+1)=CRIT(I) HEIGHT(J+1)=I-(N-9) LOC=LOC+1 ENDIF 650 CONTINUE 700 CONTINUE DO 705 J=1,9 DO 703 I=1,9 IF (HVALS(I).EQ.IORDER(J)) THEN IORDER(J)=I GOTO 705 ENDIF 703 CONTINUE 705 CONTINUE C RETURN END