--- /dev/null
+ 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
projects / unres4.git / blobdiff