SUBROUTINE TRACK(ICUT) include 'DIMENSIONS' INCLUDE 'sizesclu.dat' INCLUDE 'COMMON.CLUSTER' COMMON /HISTORY/ NCUR(MAX_CUT),IBACK(MAXGR,MAX_CUT) COMMON /PREVIOUS/ NGRP,LICZP(MAXGR),NCONFP(MAXGR,MAXINGR) IF (ICUT.GT.1) THEN C Find out what of the previous families the current ones came from. DO IGR=1,NGR NCI1=NCONF(IGR,1) DO JGR=1,NGRP DO K=1,LICZP(JGR) IF (NCI1.EQ.NCONFP(JGR,K)) THEN IBACK(IGR,ICUT)=JGR GOTO 10 ENDIF ENDDO ! K ENDDO ! JGR 10 CONTINUE ENDDO ! IGR ENDIF ! (ICUT.GT.1) C Save current partition for subsequent backtracking. NCUR(ICUT)=NGR NGRP=NGR DO IGR=1,NGR LICZP(IGR)=LICZ(IGR) DO K=1,LICZ(IGR) NCONFP(IGR,K)=NCONF(IGR,K) ENDDO ! K ENDDO ! IGR RETURN END C------------------------------------------------------------------------------ SUBROUTINE WRITRACK include 'DIMENSIONS' INCLUDE 'sizesclu.dat' INCLUDE 'COMMON.CLUSTER' include 'COMMON.IOUNITS' COMMON /HISTORY/ NCUR(MAX_CUT),IBACK(MAXGR,MAX_CUT) COMMON /PREVIOUS/ NGRP,LICZP(MAXGR),NCONFP(MAXGR,MAXINGR) DIMENSION IPART(MAXGR/5,MAXGR/5) c do icut=2,ncut c write (iout,'(a,f10.5)') 'Cut-off',rcutoff(icut) c write (iout,'(16i5)') (iback(k,icut),k=1,ncur(icut)) c enddo C C Print the partition history. C DO ICUT=2,NCUT NCU=NCUR(ICUT) NCUP=NCUR(ICUT-1) cd print *,'icut=',icut,' ncu=',ncu,' ncur=',ncur WRITE(iout,'(A,f10.5,A,f10.5)') & 'Partition of families obtained at cut-off',RCUTOFF(ICUT-1), & ' at cut-off',RCUTOFF(ICUT) DO I=1,NCUP NPART=0 cd print *,'i=',i DO J=1,NCU IF (IBACK(J,ICUT).EQ.I) THEN NPART=NPART+1 IPART(NPART,I)=J ENDIF cd print *,'j=',j,' iback=',IBACK(J,ICUT),' npart=',npart ENDDO ! J WRITE (iout,'(16I5)') I,(IPART(K,I),K=1,NPART) ENDDO ! I ENDDO ! ICUT RETURN END C------------------------------------------------------------------------------ SUBROUTINE PLOTREE include 'DIMENSIONS' INCLUDE 'sizesclu.dat' INCLUDE 'COMMON.CLUSTER' include 'COMMON.IOUNITS' COMMON /HISTORY/ NCUR(MAX_CUT),IBACK(MAXGR,MAX_CUT) COMMON /PREVIOUS/ NGRP,LICZP(MAXGR),NCONFP(MAXGR,MAXINGR) DIMENSION Y(MAXGR,MAX_CUT) DIMENSION ITREE(MAXGR,MAX_CUT),IFIRST(MAXGR,MAX_CUT), &ILAST(MAXGR,MAX_CUT),IFT(MAXGR),ILT(MAXGR),ITR(MAXGR) CHARACTER*32 FD external ilen C C Generate the image of the tree (tentatively for LaTeX picture environment). C C C First untangle the branches of the tree C DO I=1,NCUR(1) ITREE(I,1)=I ENDDO DO ICUT=NCUT,2,-1 C C Determine the order of families for the (icut)th partition. C NCU=NCUR(ICUT) NCUP=NCUR(ICUT-1) NPART=0 DO I=1,NCUP IS=0 IF (I.GT.1) ILAST(I-1,ICUT-1)=NPART DO J=1,NCU IF (IBACK(J,ICUT).EQ.I) THEN NPART=NPART+1 IF (IS.EQ.0) THEN IS=1 IFIRST(I,ICUT-1)=NPART ENDIF ITREE(NPART,ICUT)=J ENDIF ENDDO ! J ENDDO ! I ILAST(NCUP,ICUT-1)=NPART cd print *,'i=',i,' ncup=',ncup,' ncu=',ncu,' npart=',npart ENDDO ! ICUT c diagnostic printout cd do icut=1,ncut cd write (iout,*) 'Cut-off',icut,' = ',rcutoff(icut) cd write (iout,*) 'ITREE' cd write (iout,*) (itree(i,icut),i=1,ncur(icut)) cd write (iout,*) 'IFIRST, ILAST' cd write (iout,*) (ifirst(i,icut),ilast(i,icut),i=1,ncur(icut)) cd enddo C C Propagate the order of families from cut-off #2 to cut-off #n. C DO ICUT=1,NCUT-1 DO J=1,NCUR(ICUT) IFT(J)=IFIRST(J,ICUT) ILT(J)=ILAST(J,ICUT) ENDDO ! J DO J=1,NCUR(ICUT+1) ITR(J)=ITREE(J,ICUT+1) ENDDO DO I=1,NCUR(ICUT) ITI=ITREE(I,ICUT) c write (iout,*) 'icut=',icut,' i=',i,' iti=',iti C IF (ITI.NE.I) THEN JF1=IFT(I) JF2=IFT(ITI) JL1=ILT(I) JL2=ILT(ITI) JR1=JL1-JF1+1 JR2=JL2-JF2+1 Cd write (iout,*) 'jf1=',jf1,' jl1=',jl1,' jf2=',jf2, Cd & ' jl2=',jl2 Cd write (iout,*) 'jr1=',jr1,' jr2=',jr2 C Update IFIRST and ILAST. ILAST(I,ICUT)=IFIRST(I,ICUT)+JR2-1 IFIRST(I+1,ICUT)=ILAST(I,ICUT)+1 C Update ITREE. JF11=IFIRST(I,ICUT) Cd write(iout,*) 'jf11=',jf11 DO J=JF2,JL2 Cd write (iout,*) j,JF11+J-JF2,ITR(J) ITREE(JF11+J-JF2,ICUT+1)=ITR(J) ENDDO Cd write (iout,*) (ifirst(k,icut),ilast(k,icut),k=1,i) Cd write (iout,*) (itree(k,icut+1),k=1,ilast(i,icut)) C ENDIF ! (ITI.NE.I) ENDDO ! I ENDDO ! ICUT c diagnostic printout cd do icut=1,ncut cd write (iout,*) 'Cut-off',icut,' = ',rcutoff(icut) cd write (iout,*) 'ITREE' cd write (iout,*) (itree(i,icut),i=1,ncur(icut)) cd write (iout,*) 'IFIRST, ILAST' cd write (iout,*) (ifirst(i,icut),ilast(i,icut),i=1,ncur(icut)) cd enddo C C Generate the y-coordinates of the branches. C XLEN=400.0/(ncut-1) YLEN=600.0 xbox=xlen/4.0 deltx=0.5*(xlen-xbox) NNC=NCUR(NCUT) ybox=ylen/(2.0*nnc) DO J=1,NNC Y(J,NCUT)=J*YLEN/NNC ENDDO DO ICUT=NCUT-1,1,-1 NNC=NCUR(ICUT) DO J=1,NNC KF=IFIRST(J,ICUT) KL=ILAST(J,ICUT) YY=0.0 DO K=KF,KL YY=YY+Y(K,ICUT+1) ENDDO Y(J,ICUT)=YY/(KL-KF+1) ENDDO ! J ENDDO ! ICUT c diagnostic output cd do icut=1,ncut cd write(iout,*) 'Cut-off=',rcutoff(icut) cd write(iout,'(8f10.3)') (y(j,icut),j=1,ncur(icut)) cd enddo C C Generate LaTeX script for tree plot C iylen=ylen #ifdef AIX call fdate_(fd) #else call fdate(fd) #endif write(jplot,'(80(1h%))') write(jplot,'(a)') '% LaTeX code for minimal-tree plotting.' write(jplot,'(3a)') '% Created by UNRES_CLUST on ', & fd(:ilen(fd)),'.' write(jplot,'(2a)') '% To change the dimensions use the LaTeX', & ' \\unitlength=number command.' write(jplot,'(a)') '% The default dimensions fit an A4 page.' write(jplot,'(80(1h%))') write(jplot,'(a,i5,a)') '\\begin{picture}(1,1)(0,',iylen,')' ycur=ylen+ybox do icut=ncut,1,-1 xcur=xlen*(icut-1) write(jplot,'(a,f6.1,a,f6.1,a,f4.2,a)') & ' \\put(',xcur,',',ycur,'){',rcutoff(icut),' \\AA}' enddo ! icut xcur=0.0 xdraw=xcur+xbox nnc=ncur(1) write(jplot,'(a,i3,a)') '% Begin cut-off',1,'.' do j=1,nnc ydraw=y(j,1) ycur=ydraw-0.5*ybox ideltx=deltx write(jplot,'(4(a,f6.1),a,i3,a)') & ' \\put(',xcur,',',ycur,'){\\framebox(',xbox,',',ybox,'){', & itree(j,1),'}}' write(jplot,'(2(a,f6.1),2(a,i5),a,f6.1,a)') & ' \\put(',xdraw,',',ydraw,'){\\line(',ideltx, & ',',0,'){',deltx,'}}' enddo ! j do icut=2,ncut write(jplot,'(a,i3,a)') '% Begin cut-off',icut,'.' xcur=xlen*(icut-1) xdraw=xcur-deltx cd print *,'icut=',icut,' xlen=',xlen,' deltx=',deltx, cd & ' xcur=',xcur,' xdraw=',xdraw nnc=ncur(icut) do j=1,ncur(icut-1) ydraw=y(ifirst(j,icut-1),icut) delty=y(ilast(j,icut-1),icut)-y(ifirst(j,icut-1),icut) idelty=delty write(jplot,'(2(a,f6.1),2(a,i5),a,f6.1,a)') & ' \\put(',xdraw,',',ydraw,'){\\line(',0, & ',',idelty,'){',delty,'}}' enddo do j=1,nnc xcur=xlen*(icut-1) xdraw=xcur-deltx ydraw=y(j,icut) ycur=ydraw-0.5*ybox ideltx=deltx write(jplot,'(2(a,f6.1),2(a,i5),a,f6.1,a)') & ' \\put(',xdraw,',',ydraw,'){\\line(',ideltx, & ',',0,'){',deltx,'}}' write(jplot,'(4(a,f6.1),a,i3,a)') & ' \\put(',xcur,',',ycur,'){\\framebox(',xbox,',',ybox,'){', & itree(j,icut),'}}' if (icut.lt.ncut) then xdraw=xcur+xbox write(jplot,'(2(a,f6.1),2(a,i5),a,f6.1,a)') & ' \\put(',xdraw,',',ydraw,'){\\line(',ideltx, & ',',0,'){',deltx,'}}' endif enddo ! j enddo ! icut write(jplot,'(a)') '\\end{picture}' RETURN END