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 DENDRO.F -- ADAPTED FOR METAFILE 3 NOVEMBER 86 ARDEAN LEITH C USED POSTSCRIPT OUTPUT MAR 99 ARDEAN LEITH C********************************************************************** C DRAWS DENDROGRAM AND FORMS A PLOT METAFILE FOR THE DENDROGRAM C C BASED ON ARBRE.FOR, A DENDROGRAM PGM BY - JEAN-PIERRE BRETAUDIERE C THE UNIVERSITY OF TEXAS HEALTH SCIENCE CENTER AT HOUSTON C MEDICAL SCHOOL - DEPARTMENT OF PATHOLOGY AND LABORATORY MEDICINE C P.O. BOX 20708, HOUSTON, TX 77225. C*--------------------------------------------------------------------* C* C* TREE DESCRIPTION C* C* NKLA SUMMITS JFIN = 2 * NKLA - 1 C* ARRAYS PROVIDED BY CHAVA VAL(JFIN), LA(NKLA), LB(NKLA) C* PK(JFIN) C* C* WORKING ARRAYS NO(JFIN), V(NKLA), NT(NKLA), C* IW(NKLA), W(NKLA), IV(NKLA), C* NUM(NKLA) C C CALLED BY: NOYAU C C*--------------------------------------------------------------------* SUBROUTINE DENDRO(NKLA, JFIN, VAL, LA, LB, PK, IDK, & NO,NUM,NT,IV,IW,V,W,VMIN,VMAX) INCLUDE 'CMLIMIT.INC' INCLUDE 'CMBLOCK.INC' C LIMITED TO 200 LEAVES ON TREE BY NKMAX PARAMETER (NKMAX = 200) PARAMETER (NSIZE=2000) COMMON /COMMUN/ DATA(3,NSIZE),YT(NKMAX),X(NKMAX) DIMENSION VAL(JFIN),PK(JFIN),V(NKLA),W(NKLA) INTEGER LA(NKLA),LB(NKLA),IDK(NKLA),NO(JFIN),NT(NKLA) INTEGER IV(NKLA),NUM(NKLA),IW(NKLA) CHARACTER(LEN=80) :: LINE CHARACTER(LEN=10) :: CVJ,CVMIN,CVMAX CHARACTER(LEN=4) :: CNUM,CPOID CHARACTER(LEN=1) :: NULL,LIGN(102) CHARACTER(LEN=MAXNAM) :: FILPOS DATA LIG/102/ NULL = CHAR(0) C GET NAME OF POSTSCRIPT FILE AND OPEN AS SEQUENTIAL FORMATTED LUNPOS = 80 CALL OPAUXFILE(.TRUE.,FILPOS,'ps',LUNPOS,0,'N', & 'DENDROGRAM POSTSCRIPT OUTPUT',.TRUE.,IRTFLGT) IF (IRTFLGT .NE. 0) RETURN NLETP = LNBLNKN(FILPOS) 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 PRINT DESCRIPTION OF THE HIERARCHY CLASSES WRITE(NDAT,*) ' ' 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, & (MOD(IV(KK),10000),KK=1,KPT) 610 FORMAT (//1X,I4,F9.3,I5,I6,I7,5X,18(1X,I4),/' ',36X,18(1X,I4) , & /' ',36X,18(1X,I4)/' ',36X,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 PRINT GRAPH OF DENDROGRAM WRITE(NDAT,620) VMIN, VMAX 620 FORMAT (/////,6X, 'WEIGHT',4X, 'INDEX' ,9X,'DENDROGRAM', & 4X, '(SCALE ',2F7.2,' )',//) 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) C SET WINDOW SIZE (SCALING WILL BE DONE IN PLOT ROUTINES) XWIN = 120 YWIN = 100 C FIND SCALE FOR TREE (NOT INCLUDING LABELS) YSCALE = YWIN / (VMAX - VMIN) C FIND HORIZ DISTANCE BETWEEN LEAVES XDIS = XWIN / (NKLA - 1) C LENGTH OF LEAVES YLEAF = -5.0 C INITIALIZE & SET SCALING FOR POSTSCRIPT CALL POSTRT(-LUNPOS) XLL = -66.0 YLL = -26.0 XUR = 120 YUR = 110 CALL POSCALE(LUNPOS, 1.0,1.0, XLL,YLL, XUR,YUR) C SET TEXT CHARACTARISTICS FOR Y AXIS LABELS ITSIZE = 9 ITANGL = 0 JUST = 0 C PUT POSTSCRIPT FILENAME AT TOP YPOS = 120.0 XPOS = 0.0 CALL POTEX(LUNPOS,FILPOS,NLETP,XPOS,YPOS, ITSIZE,ITANGL,JUST) C RIGHT JUSTIFIED Y LABELS JUST = 2 C LABEL Y AXIS XPOS = -16.0 YPOS = -24.0 LINE = 'WEIGHT' CALL POTEX(LUNPOS,LINE,6,XPOS,YPOS, ITSIZE,ITANGL,JUST) YPOS = -18.0 LINE = 'INDEX ' CALL POTEX(LUNPOS,LINE,6,XPOS,YPOS, ITSIZE,ITANGL,JUST) C PREVIOUS LABEL WAS INTEGER, MAR 99 AL c YPOS = -21.0 c LINE = 'X1000 ' c CALL POTEX(LUNPOS,LINE,6,XPOS,YPOS, ITSIZE,ITANGL,JUST) YPOS = -12.0 LINE = 'CLASS ' CALL POTEX(LUNPOS,LINE,6,XPOS,YPOS, ITSIZE,ITANGL,JUST) YPOS = 0.0 WRITE(CVMIN,8802) VMIN CALL POTEX(LUNPOS,CVMIN,10,XPOS,YPOS, ITSIZE,ITANGL,JUST) YPOS = 100.0 WRITE(CVMAX,8802)VMAX CALL POTEX(LUNPOS,CVMAX,10,XPOS,YPOS, ITSIZE,ITANGL,JUST) YPOS = 50.0 ITANGL = 90 LINE = 'SCALE ' CALL POTEX(LUNPOS,LINE,6,XPOS,YPOS, ITSIZE,ITANGL,JUST) C SET TEXT CHARACTARISTICS FOR X AXIS LABELS ITSIZE = 5 ITANGL = 0 JUST = 0 C CENTER X AXIS LABELS JUST = 1 DO J = 1,NKLA C DO J = NKLA,1,-1 LX = (V(J) - VMIN) * PAS + 1.0 IF (LX .LT. 1) LX = 1 IF (LX .GT. LIG) LX = LIG DO II = 1,LX LIGN(II) = '.' ENDDO C FIND NODE HEIGHT (Y) X(J) = (J-1) * XDIS YT(J) = (V(J) - VMIN) * YSCALE JJ = IW(NKLA-J+1) POID = PK(JJ) C SET LEAF POSITION XPOS = X(J) C LABEL THE LEAF WITH WEIGHT YPOS = -24.0 IPOID = POID WRITE(CPOID,8800)IPOID 8800 FORMAT(I4) IT = 1 IF (CPOID(:1) .EQ. ' ') IT = 2 CALL POTEX(LUNPOS,CPOID(IT:4),5-IT,XPOS,YPOS, & ITSIZE,ITANGL,JUST) C LABEL LEAF WITH CLASS NUMBER NUM(J) YPOS = -12.0 WRITE(CNUM,801) NUM(J) 801 FORMAT(I4) CALL POTEX(LUNPOS,CNUM(2:4),3,XPOS,YPOS,ITSIZE,ITANGL,JUST) C LABEL THE LEAF WITH THE INDEX YPOS = -18.0 IF (J .NE. NKLA) THEN C LABEL THE LEAF WITH THE INDEX C PREVIOUS LABEL WAS AN INTEGER MAR 99 IVT = V(J) * 1000 WRITE(CVJ,8801)IVT 8801 FORMAT(I3) WRITE(CVJ,8802) V(J) 8802 FORMAT(1PG10.2) CALL POTEX(LUNPOS,CVJ,10,XPOS,YPOS, ITSIZE,ITANGL,JUST) WRITE(NDAT,630) POID, V(J), NUM(J), (LIGN(L),L=1,LIG) 630 FORMAT (' ',2F10.3,1X,I4,2X,'..',102A1) ELSE C LABEL THE LEAF WITH NULL INDEX LINE = ' --' CALL POTEX(LUNPOS,LINE,3,XPOS,YPOS, ITSIZE,ITANGL,JUST) WRITE(NDAT,650) POID, NUM(NKLA), (LIGN(L),L=1,LIG) 650 FORMAT (' ',F10.3,4X,6('-'),1X,I4,2X,'..',102A1) ENDIF IF (LX .EQ. 1) GO TO 110 LX = LX - 1 DO LL = 1,LX LIGN(LL) = ' ' ENDDO 110 WRITE(NDAT,640) (LIGN(L),L=1,LIG) 640 FORMAT (' ',29X,102A1) ENDDO C START I SWEEP DO I=1,NKLA YTI = YT(I) C DRAW VERTICAL LINE DATA(1,1) = X(I) DATA(2,1) = YLEAF DATA(1,2) = X(I) DATA(2,2) = YTI NDATA = 2 IF (I .EQ. NKLA) GOTO 340 C FIND LENGTH OF HORIZONTAL LINE DO J = I+1,NKLA YTJ = YT(J) IF (YTJ .GE. YTI) GOTO 330 ENDDO C NO HIGHER BRANCH FOUND, POSSIBLE ERROR GOTO 300 C DRAW HORIZONTAL LINE 330 DATA(1,3) = X(J) DATA(2,3) = YTI NDATA = 3 C PUSH DATA INTO FILE 340 CALL POARAYF(LUNPOS,DATA,NDATA,.FALSE.,.FALSE.) 300 CONTINUE ENDDO C TICK MARKS AT Y = 0 AND Y = YMAX CALL POSEG(LUNPOS, -3.0,0.0, -1.0,0.0) CALL POSEG(LUNPOS, -3.0,100.0, -1.0,100.0) C CLOSE THE POSTSCRIPT-FILE 9998 CALL POEND(LUNPOS) WRITE(NOUT,*) ' PLOT PLACED IN: ',FILPOS(1:NLETP) 9999 CLOSE(LUNPOS) END