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 DENDRO2.FOR-- ADAPTED FROM DENDRO.FOR 2 JUNE 89 al C C********************************************************************** C FORMS A TRUNCATED 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), IDK(NKLA) 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 DENDRO2(NKLA, JFIN, VAL, LA, LB, PK, IDK, & NO,NUM,NT,IV,IW,V,W,VMIN,VMAX) INCLUDE 'CMBLOCK.INC' C LIMITED TO 2000 LEAVES ON TREE BY NKMAX PARAMETER (NKMAX = 2000) PARAMETER (NSIZE = 2000) COMMON /COMMUN/ DATA(3,NSIZE),X(NKMAX),YT(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),INUM CHARACTER * 81 FILPOS CHARACTER * 80 LINE CHARACTER * 10 CVJ,CVMIN,CVMAX CHARACTER * 4 CNUM,CPOID CHARACTER * 1 NULL,LIGN(102) NULL = CHAR(0) JDEB = NKLA + 1 VMIN = VAL(JDEB) VMAX = VAL(JFIN) WRITE(NOUT,9000) VMIN,VMAX 9000 FORMAT(/' INDEX RANGE:',1PG12.5,'...',1PG12.5/) CALL RDPRM2(PMIN,PMAX,NOT_USED,'ENTER PLOT CUTOFF') 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) 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 DO J = JDEB,JFIN NT(1) = J KPT = 0 JI = 1 20 IF (NT(JI) .GT. NKLA) THEN IJ = JI + 1 NI = NT(JI) - JDEB + 1 NT(IJ) = LA(NI) NT(JI) = LB(NI) JI = JI + 1 ELSE K = NT(JI) KPT = KPT + 1 IV(KPT) = IDK(K) IW(KPT) = K NUM(NKLA-KPT+1) = IDK(K) JI = JI - 1 ENDIF IF (JI .NE. 0) GO TO 20 IR = J - JDEB + 1 I1 = IW(1) I2 = IW(KPT) W(I1) = NO(J) + 0.0001 W(I2) = NO(I2) + 0.0001 ENDDO DO J = 1,NKLA K = W(J) W(J) = VAL(K) ENDDO ITIMES = 1000 DO J = 1,NKLA IWI = IW(J) VT = W(IWI) V(NKLA-J+1) = VT VT1000 = VT * 1000 IF (VT1000 .GT. 999) ITIMES = 1000000 ENDDO 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 = -24.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 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) C YPOS = -19.0 C LINE = 'X10**3' C IF (ITIMES .GT. 1000) LINE = 'X10**6' C 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) YPOS = -12.0 LINE = 'CLASS ' CALL POTEX(LUNPOS,LINE,6,XPOS,YPOS, ITSIZE,ITANGL,JUST) YPOS = 0.0 WRITE(CVMIN,8802)PMIN 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 LABEL ITSIZE = 5 ITANGL = 0 C CENTER X AXIS LABELS JUST = 1 DO 120 J = 1,NKLA C FIND NODE HEIGHT (Y) X(J) = (J-1) * XDIS VT = V(J) C DO NOT LABEL TRUNCATED LINES IF (VT .LE. PMIN) GOTO 120 YT(J) = (VT - PMIN) * 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) IF (J .NE. NKLA) THEN C LABEL THE LEAF WITH THE INDEX V(J) YPOS = -18.0 WRITE(CVJ,8802) V(J) 8802 FORMAT(G10.2) CALL POTEX(LUNPOS,CVJ,10,XPOS,YPOS, ITSIZE,ITANGL,JUST) ELSE C LABEL THE LEAF WITH NULL INDEX YPOS = -18.0 LINE = ' --' CALL POTEX(LUNPOS,LINE,3,XPOS,YPOS, ITSIZE,ITANGL,JUST) ENDIF 120 CONTINUE C START I SWEEP DO 300 I=1,NKLA C DO NOT PLOT TUNCATED LINES VT = V(I) IF (VT .LE. PMIN) GOTO 300 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 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