C @(#)densbr.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.IDENTIFICATION: C DENDR VERSION 1 85.01.21 C F. MURTAGH ST-ECF, MUNICH. C C.KEYWORDS: C APPLICATIONS, STATISTICS, CLUSTERING. C C.PURPOSE: C CONSTRUCT A DENDROGRAM (TREE) REPRESENTATION OF A C HIERARCHIC CLUSTERING. C C.ALGORITHM: C TAKE AS INPUT: THE ORDERING OF OBJECTS ALONG THE BOTTOM C OF THE DENDROGRAM ("IORDER"); THE HEIGHT OF THE VERTICAL C ABOVE EACH OBJECT, IN ORDINAL VALUES ("HEIGHT"), AND IN C REAL VALUES ("CRITVAL"). C BUILD UP THE DENDROGRAM IN ARRAY "OUT". C C.INPUT/OUTPUT: C PARAMETERS: C IORDER, HEIGHT, CRITVAL : VECTORS DEFINING THE DENDROGRAM. C *** NOTE *** THE IJKLMN VARIABLE TYPE CONVENTION IS USED. C C--------------------------------------------------------------- C SUBROUTINE DENDR(IORDER,HEIGHT,CRITVAL) C CHARACTER*80 LINE INTEGER IORDER(9),HEIGHT(9) REAL CRITVAL(9) INTEGER I,J,K,I2,J2,I3,IC,IDUM INTEGER ISTAT,L CHARACTER*1 OUT(27,27),UP,ACROSS,BLANK DATA UP,ACROSS,BLANK/'|','-',' '/ C C DO I=1,27 DO J=1,27 OUT(I,J)=BLANK ENDDO ENDDO C C DO I=3,27,3 I2=I/3 C J2=28-3*HEIGHT(I2) DO J=27,J2,-1 OUT(J,I)=UP ENDDO C DO K=I,3,-1 I3=INT((K+2)/3) IF ( (28-HEIGHT(I3)*3).LT.J2) GOTO 100 OUT(J2,K)=ACROSS ENDDO 100 CONTINUE C ENDDO C C IC=3 DO I=1,27 IF (I.EQ.IC+1) THEN IDUM=IC/3 IDUM=9-IDUM DO L=1,9 IF (HEIGHT(L).EQ.IDUM) GOTO 190 ENDDO 190 IDUM=L LINE = ' ' WRITE(LINE,200) CRITVAL(IDUM),(OUT(I,J),J=1,27) CALL STTPUT(LINE,ISTAT) IC=IC+3 ELSE LINE = ' ' WRITE(LINE,210) (OUT(I,J),J=1,27) CALL STTPUT(LINE,ISTAT) ENDIF 200 FORMAT(1X,8X,F16.2,27A1) 210 FORMAT(1X ,24X,27A1) ENDDO LINE = ' ' CALL STTPUT(LINE,ISTAT) WRITE(LINE,220)(IORDER(J),J=1,9) CALL STTPUT(LINE,ISTAT) 220 FORMAT(1X ,24X,9I3) LINE = ' ' CALL STTPUT(LINE,ISTAT) WRITE(LINE,230) CALL STTPUT(LINE,ISTAT) 230 FORMAT(1X ,13X,'CRITERION CLUSTERS 1 TO 9') LINE = ' ' WRITE(LINE,240) CALL STTPUT(LINE,ISTAT) 240 FORMAT(1X ,13X,'VALUES. (TOP 8 LEVELS OF HIERARCHY).') C C RETURN END