module tracking !------------------------------------------------------------------------------ use clust_data implicit none !------------------------------------------------------------------------------ ! COMMON /HISTORY/ integer :: NCUR(MAX_CUT),IBACK(MAXGR,MAX_CUT) ! COMMON /PREVIOUS/ integer :: NGRP,LICZP(MAXGR),NCONFP(MAXGR,MAXINGR) !------------------------------------------------------------------------------ ! ! !------------------------------------------------------------------------------ contains !------------------------------------------------------------------------------ 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) integer :: icut,igr,jgr,k,nci1 IF (ICUT.GT.1) THEN ! 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) ! 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 SUBROUTINE TRACK !------------------------------------------------------------------------------ SUBROUTINE WRITRACK use io_units, only: iout ! 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) integer :: IPART(MAXGR/5,MAXGR/5) integer :: icut,i,j,k,ncu,ncup,npart ! do icut=2,ncut ! write (iout,'(a,f10.5)') 'Cut-off',rcutoff(icut) ! write (iout,'(16i5)') (iback(k,icut),k=1,ncur(icut)) ! enddo ! ! Print the partition history. ! DO ICUT=2,NCUT NCU=NCUR(ICUT) NCUP=NCUR(ICUT-1) !d 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 !d print *,'i=',i DO J=1,NCU IF (IBACK(J,ICUT).EQ.I) THEN NPART=NPART+1 IPART(NPART,I)=J ENDIF !d 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 SUBROUTINE WRITRACK !------------------------------------------------------------------------------ SUBROUTINE PLOTREE use io_units, only: jplot use io_base, only: ilen ! 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) integer,DIMENSION(MAXGR,MAX_CUT) :: Y integer,DIMENSION(MAXGR,MAX_CUT) :: ITREE,IFIRST,ILAST integer,dimension(MAXGR) :: IFT,ILT,ITR CHARACTER(len=32) :: FD integer :: i,icut,j,k,is,iti,jf1,jf2,jl1,jl2,ncu,ncup,npart integer :: jr1,jr2,jf11,kl,kf,nnc,iylen,ideltx,idelty real(kind=8) :: xlen,ylen,xbox,ybox,deltx,yy real(kind=8) :: ycur,xcur,xdraw,ydraw,delty !el external ilen ! ! Generate the image of the tree (tentatively for LaTeX picture environment). ! ! ! First untangle the branches of the tree ! DO I=1,NCUR(1) ITREE(I,1)=I ENDDO DO ICUT=NCUT,2,-1 ! ! Determine the order of families for the (icut)th partition. ! 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 !d print *,'i=',i,' ncup=',ncup,' ncu=',ncu,' npart=',npart ENDDO ! ICUT ! diagnostic printout !d do icut=1,ncut !d write (iout,*) 'Cut-off',icut,' = ',rcutoff(icut) !d write (iout,*) 'ITREE' !d write (iout,*) (itree(i,icut),i=1,ncur(icut)) !d write (iout,*) 'IFIRST, ILAST' !d write (iout,*) (ifirst(i,icut),ilast(i,icut),i=1,ncur(icut)) !d enddo ! ! Propagate the order of families from cut-off #2 to cut-off #n. ! 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) ! write (iout,*) 'icut=',icut,' i=',i,' iti=',iti ! 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 !d write (iout,*) 'jf1=',jf1,' jl1=',jl1,' jf2=',jf2, !d & ' jl2=',jl2 !d write (iout,*) 'jr1=',jr1,' jr2=',jr2 ! Update IFIRST and ILAST. ILAST(I,ICUT)=IFIRST(I,ICUT)+JR2-1 IFIRST(I+1,ICUT)=ILAST(I,ICUT)+1 ! Update ITREE. JF11=IFIRST(I,ICUT) !d write(iout,*) 'jf11=',jf11 DO J=JF2,JL2 !d write (iout,*) j,JF11+J-JF2,ITR(J) ITREE(JF11+J-JF2,ICUT+1)=ITR(J) ENDDO !d write (iout,*) (ifirst(k,icut),ilast(k,icut),k=1,i) !d write (iout,*) (itree(k,icut+1),k=1,ilast(i,icut)) ! ENDIF ! (ITI.NE.I) ENDDO ! I ENDDO ! ICUT ! diagnostic printout !d do icut=1,ncut !d write (iout,*) 'Cut-off',icut,' = ',rcutoff(icut) !d write (iout,*) 'ITREE' !d write (iout,*) (itree(i,icut),i=1,ncur(icut)) !d write (iout,*) 'IFIRST, ILAST' !d write (iout,*) (ifirst(i,icut),ilast(i,icut),i=1,ncur(icut)) !d enddo ! ! Generate the y-coordinates of the branches. ! 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 ! diagnostic output !d do icut=1,ncut !d write(iout,*) 'Cut-off=',rcutoff(icut) !d write(iout,'(8f10.3)') (y(j,icut),j=1,ncur(icut)) !d enddo ! ! Generate LaTeX script for tree plot ! 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 !d print *,'icut=',icut,' xlen=',xlen,' deltx=',deltx, !d & ' 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 SUBROUTINE PLOTREE !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ end module tracking