DIMENSION XSTACK(1),YSTACK(1),TSTACK(1)
DIMENSION LINKL(1),LINKR(1),YLEV(1),XCOORD(1)
C
C THE PROGRAM THAT ACTS AS CORE GETTER FOR DENPLT
C WHICH IS NOW CALLED AS DENWKS S/R
C
COMMON KI,KO,INDSK,IODSK
CALL INIT
C
C GET DIMENSIONS FROM AVGE.DAT FOR CORE MAX CALCULATION
C
CALL IFILE(INDSK,'AVGE')
READ(INDSK)I,J,K
J=MAX0(J,K)
J=MAX0(J,I)
JJ=J+J
CALL RELEAS(INDSK)
C
C NOW GET THE CORE
C
CALL MORCOR(XSTACK,IX,J)
CALL MORCOR(YSTACK,IY,J)
CALL MORCOR(TSTACK,IT,JJ)
CALL MORCOR(LINKL,IL,JJ)
CALL MORCOR(LINKR,IR,JJ)
CALL MORCOR(YLEV,IV,JJ+2)
CALL MORCOR(XCOORD,IC,JJ)
C
C AND GO DO THE WORKS
C
CALL PLTWKS(J,XSTACK(IX),YSTACK(IY),TSTACK(IT),
1 LINKL(IL),LINKR(IR),YLEV(IV),XCOORD(IC))
C
CALL RUN5
CALL EXIT
END
SUBROUTINE PLTWKS(MD,XSTACK,YSTACK,TSTACK,LINKL,LINKR,YLEV
1 ,XCOORD)
C
C SUBROUTINE TO PLOT 4 DENDROGRAMS
C
DIMENSION XSTACK(1),YSTACK(1)
DIMENSION TSTACK(1)
DIMENSION LINKL(1),LINKR(1),YLEV(1),XCOORD(1)
DIMENSION T(8),IDO(4),ST(13)
LOGICAL PLOTNG
C
C INPUT IS FROM DEN(1-4).DAT
C
C OUTPUT IS TO PLT AND RESVC.DAT
C
COMMON KI,KO,I1,I2
C
C INITIALISE AND GET OPTIONS
C
CALL GPLT(IDO)
XAXLEN=500.0
YAXLEN=600.0
MAXDIM=MD
MDMD=MD+MD
NPLOT=0
C
C RESVC CONTAINS INDICES FOR MATRIX PRINTOUT
C
CALL OFILE(I2,'RESVC')
C
C INIIALISE FOR EACH PLOT
C
1 YMAX=0.
YBOTAX=1.0E10
XPROG=0.
IPT=0
IPX=0
IPY=0
NMAX=0
DO 2 I=1,MAXDIM*2
LINKL(I)=0
LINKR(I)=0
YLEV(I)=0.
2 XCOORD(I)=0.
C
C MAKE FILENAME, AND TAKE INPUT IF NECESSARY
C
3 NPLOT=NPLOT+1
IF(NPLOT.EQ.5) GO TO 200
IF( .NOT.(IDO(NPLOT) .GE. 0) )GO TO 3
PLOTNG = .FALSE.
IF(IDO(NPLOT) .GE. 2) PLOTNG = .TRUE.
ENCODE(5,4,IFLE) NPLOT
4 FORMAT('DENI',I1)
CALL IFILE(I1,IFLE)
C
C PARAMETERS AND TITLES FOR THIS PLOT
C
READ(I1) NBASE
READ(I1) T,ST
XINC=XAXLEN/(NBASE+1)
C
C THE INPUT LOOP FOR THE TREE
C
7 READ(I1,END=15) NL,NR,NCURR,YIN
10 FORMAT(1X,3I,F)
C
C UPDATE THE MAX Y CO-ORD AND NUMBER FO NODES
C
C
IF(YIN.GT.YMAX)YMAX=YIN
IF(YIN.LT.YBOTAX)YBOTAX=YIN
IF(NCURR.GT.NMAX)NMAX=NCURR
C
C SET UP TREE ENTRY FOR CURRENT NODE NCURR
C LINKL AND LINKR POINT DOWN THE TREE LEFT AND RIGHT RESPECTIVELY
C
LINKL(NCURR)=NL
LINKR(NCURR)=NR
YLEV(NCURR)=YIN
GO TO 7
C
C
C THE PLOTTING LOOP - INITIALISE FOR THIS PLOT
C
15 ENCODE(5,12,FILE) NPLOT
12 FORMAT('DENP',I1)
IF(PLOTNG)
#CALL PLOTIN(FILE,XAXLEN+50.,$120,.FALSE.,'PLT1',.FALSE.)
C
C AMEND ALL Y POIINTS OF SINGLE ENTS/ATRS TO BE AT MINIMUM
C Y LEVEL OF ALL FUSIONS. THIS EXPANDS SCALE OF DENROG Y AXIS
C
DO 13 J=1,NBASE
13 YLEV(J)=YBOTAX
CALL SCALE(YLEV,YAXLEN-40.,NMAX,1)
IF( .NOT. PLOTNG) GO TO 18
IF(NPLOT.EQ.1)
1CALL PLTOPR('PLEASE CHECK ALL PENS ARE OPERABLE......',40)
IF(NPLOT.EQ.1)
1CALL PLTOPR('.. AND INKED ON LARGE PLOTTER- C.ANDREWS',40)
18 YFIRST=YLEV(NMAX+1)
YDELT=YLEV(NMAX+2)
C
C INITIALISE NEW ORIGIN FOR PLOT
C
IF( .NOT. PLOTNG) GO TO 19
CALL PLOT(15.,15.,-3)
CALL NEWPEN(1)
C
C START TRAVERSE OF TREE AT ITS TOP
C
19 NODE=NMAX
C
C IF THERE IS A LEFT LINK GO DOWN IT AND STACK PAST HISTORY OF VISIT
C
C
20 IF(LINKL(NODE).EQ.0)GO TO 25
LASTN=NODE
NODE=LINKL(NODE)
LINKL(LASTN)=0
CALL STACK(TSTACK,IPT,'L',MDMD,$100)
CALL STACK(TSTACK,IPT,LASTN,MDMD,$100)
GO TO 20
C
C IF THERE IS A RIGHT BRANCH GO DOWN IT IN SAME WAY
C
25 IF(LINKR(NODE).EQ.0)GO TO 30
LASTN=NODE
NODE=LINKR(NODE)
LINKR(LASTN)=0
CALL STACK(TSTACK,IPT,'R',MDMD,$100)
CALL STACK(TSTACK,IPT,LASTN,MDMD,$100)
GO TO 20
C
C NO LEFT OR RIGHT LINK SO WE ARE AT A LEAF
C
30 CALL UNSTK(TSTACK,IPT,NLAST,$105)
CALL UNSTK(TSTACK,IPT,TRAV,$110)
C
C GET XCOORD OF NODE - NON ZERO IF ITS GOT ONE
C
XC=XCOORD(NODE)
IF(XC.NE.0)GO TO 32
C
C WRITE IT IN THE RESORTED VECTOR AND ALLOCATE IT SPACE ON X AXIS
C
WRITE(I2)NODE
XPROG=XPROG+XINC
XC=XPROG
XCOORD(NODE)=XC
C
C FIX ITS Y COORD
C
32 YL=YLEV(NLAST)
IF(YLEV(NODE).EQ.YBOTAX.AND.NODE.LE.NBASE)YLEV(NODE)=YFIRST
YTEMP1=(YLEV(NODE)-YFIRST)/YDELT
IF(TRAV.EQ.'R')GO TO 40
C
C PLOT IT OUT
C IF A LEFT BRANCH HAS BEEN TRAVERSED TO GET HERE THEN A VERT LINE
C
IF( .NOT. PLOTNG) GO TO 35
CALL PLOT(XC,YTEMP1,3)
CALL NUMBER(XC,YTEMP1-5.0,2.8,FLOAT(NODE)
1 ,0.,-1)
CALL PLOT(XC,YTEMP1,3)
CALL PLOT(XC,(YL-YFIRST)/YDELT,2)
C
C AND STACK FOR LATER JOIN
C
35 CALL STACK(XSTACK,IPX,XC,MD,$100)
CALL STACK(YSTACK,IPY,YL,MD,$100)
GO TO 60
C
C IF A RIGHT MOST BRANCH HAS BEEN TRAVERSED THEN PLOT A VERT LINE
C FOLLOWED BY A HORIZONTAL LINE TO MEET THE PREVIOUSLY STACKED ONE
C
C
40 CALL UNSTK(XSTACK,IPX,XTOP,$110)
CALL UNSTK(YSTACK,IPY,YTOP,$110)
IF( .NOT. PLOTNG) GO TO 45
CALL PLOT(XC,YTEMP1,3)
CALL NUMBER(XC,YTEMP1-5.0,2.8,FLOAT(NODE),
1 0.,-1)
CALL PLOT(XC,YTEMP1,3)
45 YTEMP2=(YTOP-YFIRST)/YDELT
IF( .NOT. PLOTNG) GO TO 47
CALL PLOT(XC,YTEMP2,2)
CALL PLOT(XTOP,YTEMP2,1)
47 XCOORD(NLAST)=XC+(XTOP-XC)/2.
C
C FINISHED THIS LEAF => GO BACK UP TREE AND TRAVERSE
C
60 NODE=NLAST
GO TO 20
C
C ERROR RETURNS
C
100 TYPE 1000
GO TO 105
C
C END OF PLOT
C
105 IF( .NOT. PLOTNG) GO TO 107
TYPE 1050, NPLOT
YT=(YLEV(NMAX)-YFIRST)/YDELT
XT=XCOORD(NMAX)
CALL NUMBER(XT,YT-5.0,2.1,FLOAT(NMAX),0.,-1)
CALL PLOT(XT,YT,3)
CALL PLOT(XT,YT+5.0,2)
C
C AT END OF PLOT GO BACK AND DRAW THE TITLES,AXES & BASE LINE
TBAS=YT+10.0
CALL NEWPEN(3)
CALL SYMBOL(32.5,TBAS+60.0,7.0,ST,0.,65)
CALL NEWPEN(2)
CALL SYMBOL(32.5,TBAS+30.0,3.5,T,0.0,40)
CALL AXIS(0.,0.,'GROUP FUSION DISSIMILARITY',26,YAXLEN,
1 90.0,YFIRST,YDELT)
CALL PLOT(0.0,0.0,3)
CALL PLOT(XAXLEN,0.0,2)
CALL PLOT(0.,0.,999)
107 CALL RELEAS(I1)
GO TO 1
C
C ERROR RETURNS CONT
C
110 TYPE 1100
GO TO 105
115 TYPE 1150
GO TO 105
120 TYPE 1200
GO TO 1
C
C END OF WHOLE PROGRAM
C
200 CALL RELEAS(I2)
C
RETURN
C
1000 FORMAT(' STACK OVERFLOW')
1050 FORMAT(' END OF DENDROGRAM: ',I2)
1100 FORMAT(' STACK EMPTY')
1150 FORMAT(' INPUT OVERFLOW')
1200 FORMAT(' PLOTI ERROR')
END
SUBROUTINE STACK(STACKA,IPOINT,VAR,LIM,$)
DIMENSION STACKA(1)
IPOINT=IPOINT+1
IF(IPOINT.GT.LIM) RETURN 5
STACKA(IPOINT)=VAR
RETURN
END
SUBROUTINE UNSTK(STACKA,IPOINT,VAR,$)
DIMENSION STACKA(1)
IF(IPOINT.EQ.0) RETURN 4
VAR=STACKA(IPOINT)
IPOINT=IPOINT-1
RETURN
END