C ********************************************************************** C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM. AUTHOR: J.FRANK * C=* Copyright (C) 1985-2005 Health Research Inc. * C=* * C=* HEALTH RESEARCH INCORPORATED (HRI), * C=* ONE UNIVERSITY PLACE, RENSSELAER, NY 12144-3455. * C=* * C=* Email: spider@wadsworth.org * 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 the * C=* 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 GNU * C=* General Public License for more details. * C=* * C=* You should have received a copy of the GNU General Public License * C=* along with this program; if not, write to the * C=* Free Software Foundation, Inc., * C=* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * C=* * C ********************************************************************** C*--------------------------------------------------------------------* C* * C* TREE DESCRIPTION AND DENDROGRAM * C* * C* NKLA SUMMITS JFIN =2*NKLA - 1 * C* ARRAYS PROVIDED BY CHAVA VAL(JFIN), LA(NKLA), LB(NKLA) * C* PK(JFIN), IDK(NKLA) * C* * C* WORKING ARRAYS NO(JFIN), V(NKLA), NT(NKLA), * C* IW(NKLA), W(NKLA), IV(NKLA), * C* NUM(NKLA) * C* * C==06.07.80 * C==01.12.86 * C*--------------------------------------------------------------------* SUBROUTINE ARBRE(NKLA, JFIN, VAL, LA, LB, PK, IDK, & NO,NUM,NT,IV,IW,V,W,VMIN,VMAX) INCLUDE 'CMBLOCK.INC' DIMENSION VAL(JFIN),LA(NKLA),LB(NKLA),PK(JFIN),IDK(NKLA) & ,NO(JFIN),V(NKLA),NT(NKLA),IW(NKLA),W(NKLA),IV(NKLA),NUM(NKLA) CHARACTER*1 LIGN(102) DATA LIG/102/ JDEB = NKLA + 1 VMIN = VAL(JDEB) VMAX = VAL(JFIN) DO J = JDEB,JFIN IR = J - JDEB + 1 IA = LA(IR) IB = LB(IR) IF (VAL(J) .LT. VMIN) VMIN = VAL(J) IF (VAL(J) .GT. VMAX) VMAX = VAL(J) NO(IA) = J NO(IB) = J ENDDO NO(JFIN)= JFIN C DESCRIPTION OF THE HIERARCHY CLASSES WRITE(NDAT,600) 600 FORMAT (' NODE INDEX SENIOR JUNIOR SIZE' ,5X, & 'DESCRIPTION OF THE HIERARCHY CLASSES' /' ',64('. ') / ) DO J = JDEB,JFIN NT(1) = J KPT = 0 JI = 1 20 IF (NT(JI) .LE. NKLA) THEN K = NT(JI) KPT = KPT + 1 IV(KPT) = IDK(K) IW(KPT) = K NUM(NKLA-KPT+1) = IDK(K) JI = JI - 1 ELSE IJ = JI + 1 NI = NT(JI) - JDEB + 1 NT(IJ) = LA(NI) NT(JI) = LB(NI) JI = JI + 1 ENDIF IF (JI .NE. 0) GO TO 20 IR = J - JDEB + 1 WRITE(NDAT,610) J, VAL(J),LA(IR),LB(IR),KPT,(IV(KK),KK=1,KPT) 610 FORMAT & (//1X,I4,1X,1PG10.3,I5,I6,I6,4X,18(1X,I4),(/' ',36X,18(1X,I4))) I1 = IW(1) I2 = IW(KPT) W(I1) = NO(J) + 0.0001 W(I2) = NO(I2) + 0.0001 ENDDO C GRAPH OF DENDROGRAM WRITE(NDAT,620) VMIN, VMAX 620 FORMAT (' ',5X, 'WEIGHT',4X, 'INDEX' ,9X,'DENDROGRAM', & 4X, '(SCALE ',2(1X,1PG10.3),' )',//) DO J = 1,NKLA K = W(J) W(J) = VAL(K) ENDDO DO J = 1,NKLA IWI = IW(J) V(NKLA-J+1)= W(IWI) ENDDO DO L = 1,LIG LIGN(L)= ' ' ENDDO PAS = FLOAT(LIG) / (VMAX - VMIN) I1 = NKLA - 1 DO J=1,I1 LX = (V(J) - VMIN)*PAS + 1.0 IF (LX .LE. 1) LX = 1 IF (LX .GT. LIG) LX = LIG DO LL = 1,LX LIGN(LL)= '.' ENDDO JJ = IW(NKLA-J+1) POID = PK(JJ) WRITE(NDAT,630) POID, V(J), MOD(NUM(J),10000), & (LIGN(L),L=1,LIG) 630 FORMAT (' ',2(1PG10.3),1X,I4,2X,'..',102A1) IF (LX .NE. 1) THEN LX = LX - 1 DO LL = 1,LX LIGN(LL)= ' ' ENDDO ENDIF WRITE(NDAT,640) (LIGN(L),L=1,LIG) 640 FORMAT (' ',29X,102A1) ENDDO DO L = 1,LIG LIGN(L) = '.' ENDDO JJ = IW(1) POID = PK(JJ) WRITE(NDAT,650) POID, MOD(NUM(NKLA),10000), (LIGN(L),L=1,LIG) 650 FORMAT (' ',1PG10.3,4X,6('-'),1X,I4,2X,'..',102A1) RETURN END