2 !------------------------------------------------------------------------------
5 !------------------------------------------------------------------------------
7 integer :: NCUR(MAX_CUT),IBACK(MAXGR,MAX_CUT)
9 integer :: NGRP,LICZP(MAXGR),NCONFP(MAXGR,MAXINGR)
10 !------------------------------------------------------------------------------
13 !------------------------------------------------------------------------------
15 !------------------------------------------------------------------------------
16 SUBROUTINE TRACK(ICUT)
17 ! include 'DIMENSIONS'
18 ! INCLUDE 'sizesclu.dat'
19 ! INCLUDE 'COMMON.CLUSTER'
20 ! COMMON /HISTORY/ NCUR(MAX_CUT),IBACK(MAXGR,MAX_CUT)
21 ! COMMON /PREVIOUS/ NGRP,LICZP(MAXGR),NCONFP(MAXGR,MAXINGR)
22 integer :: icut,igr,jgr,k,nci1
24 ! Find out what of the previous families the current ones came from.
29 IF (NCI1.EQ.NCONFP(JGR,K)) THEN
38 ! Save current partition for subsequent backtracking.
44 NCONFP(IGR,K)=NCONF(IGR,K)
49 !------------------------------------------------------------------------------
52 use io_units, only: iout
53 ! include 'DIMENSIONS'
54 ! INCLUDE 'sizesclu.dat'
55 ! INCLUDE 'COMMON.CLUSTER'
56 ! include 'COMMON.IOUNITS'
57 ! COMMON /HISTORY/ NCUR(MAX_CUT),IBACK(MAXGR,MAX_CUT)
58 ! COMMON /PREVIOUS/ NGRP,LICZP(MAXGR),NCONFP(MAXGR,MAXINGR)
59 integer :: IPART(MAXGR/5,MAXGR/5)
60 integer :: icut,i,j,k,ncu,ncup,npart
62 ! write (iout,'(a,f10.5)') 'Cut-off',rcutoff(icut)
63 ! write (iout,'(16i5)') (iback(k,icut),k=1,ncur(icut))
66 ! Print the partition history.
71 !d print *,'icut=',icut,' ncu=',ncu,' ncur=',ncur
72 WRITE(iout,'(A,f10.5,A,f10.5)') &
73 'Partition of families obtained at cut-off',RCUTOFF(ICUT-1),&
74 ' at cut-off',RCUTOFF(ICUT)
79 IF (IBACK(J,ICUT).EQ.I) THEN
83 !d print *,'j=',j,' iback=',IBACK(J,ICUT),' npart=',npart
85 WRITE (iout,'(16I5)') I,(IPART(K,I),K=1,NPART)
89 END SUBROUTINE WRITRACK
90 !------------------------------------------------------------------------------
93 use io_units, only: jplot
94 use io_base, only: ilen
95 ! include 'DIMENSIONS'
96 ! INCLUDE 'sizesclu.dat'
97 ! INCLUDE 'COMMON.CLUSTER'
98 ! include 'COMMON.IOUNITS'
99 ! COMMON /HISTORY/ NCUR(MAX_CUT),IBACK(MAXGR,MAX_CUT)
100 ! COMMON /PREVIOUS/ NGRP,LICZP(MAXGR),NCONFP(MAXGR,MAXINGR)
101 integer,DIMENSION(MAXGR,MAX_CUT) :: Y
102 integer,DIMENSION(MAXGR,MAX_CUT) :: ITREE,IFIRST,ILAST
103 integer,dimension(MAXGR) :: IFT,ILT,ITR
104 CHARACTER(len=32) :: FD
105 integer :: i,icut,j,k,is,iti,jf1,jf2,jl1,jl2,ncu,ncup,npart
106 integer :: jr1,jr2,jf11,kl,kf,nnc,iylen,ideltx,idelty
107 real(kind=8) :: xlen,ylen,xbox,ybox,deltx,yy
108 real(kind=8) :: ycur,xcur,xdraw,ydraw,delty
111 ! Generate the image of the tree (tentatively for LaTeX picture environment).
114 ! First untangle the branches of the tree
121 ! Determine the order of families for the (icut)th partition.
128 IF (I.GT.1) ILAST(I-1,ICUT-1)=NPART
130 IF (IBACK(J,ICUT).EQ.I) THEN
134 IFIRST(I,ICUT-1)=NPART
140 ILAST(NCUP,ICUT-1)=NPART
141 !d print *,'i=',i,' ncup=',ncup,' ncu=',ncu,' npart=',npart
143 ! diagnostic printout
145 !d write (iout,*) 'Cut-off',icut,' = ',rcutoff(icut)
146 !d write (iout,*) 'ITREE'
147 !d write (iout,*) (itree(i,icut),i=1,ncur(icut))
148 !d write (iout,*) 'IFIRST, ILAST'
149 !d write (iout,*) (ifirst(i,icut),ilast(i,icut),i=1,ncur(icut))
152 ! Propagate the order of families from cut-off #2 to cut-off #n.
156 IFT(J)=IFIRST(J,ICUT)
160 ITR(J)=ITREE(J,ICUT+1)
164 ! write (iout,*) 'icut=',icut,' i=',i,' iti=',iti
172 !d write (iout,*) 'jf1=',jf1,' jl1=',jl1,' jf2=',jf2,
174 !d write (iout,*) 'jr1=',jr1,' jr2=',jr2
175 ! Update IFIRST and ILAST.
176 ILAST(I,ICUT)=IFIRST(I,ICUT)+JR2-1
177 IFIRST(I+1,ICUT)=ILAST(I,ICUT)+1
180 !d write(iout,*) 'jf11=',jf11
182 !d write (iout,*) j,JF11+J-JF2,ITR(J)
183 ITREE(JF11+J-JF2,ICUT+1)=ITR(J)
185 !d write (iout,*) (ifirst(k,icut),ilast(k,icut),k=1,i)
186 !d write (iout,*) (itree(k,icut+1),k=1,ilast(i,icut))
190 ! diagnostic printout
192 !d write (iout,*) 'Cut-off',icut,' = ',rcutoff(icut)
193 !d write (iout,*) 'ITREE'
194 !d write (iout,*) (itree(i,icut),i=1,ncur(icut))
195 !d write (iout,*) 'IFIRST, ILAST'
196 !d write (iout,*) (ifirst(i,icut),ilast(i,icut),i=1,ncur(icut))
199 ! Generate the y-coordinates of the branches.
204 deltx=0.5*(xlen-xbox)
219 Y(J,ICUT)=YY/(KL-KF+1)
224 !d write(iout,*) 'Cut-off=',rcutoff(icut)
225 !d write(iout,'(8f10.3)') (y(j,icut),j=1,ncur(icut))
228 ! Generate LaTeX script for tree plot
236 write(jplot,'(80(1h%))')
237 write(jplot,'(a)') '% LaTeX code for minimal-tree plotting.'
238 write(jplot,'(3a)') '% Created by UNRES_CLUST on ',&
240 write(jplot,'(2a)') '% To change the dimensions use the LaTeX',&
241 ' \\unitlength=number command.'
242 write(jplot,'(a)') '% The default dimensions fit an A4 page.'
243 write(jplot,'(80(1h%))')
244 write(jplot,'(a,i5,a)') '\\begin{picture}(1,1)(0,',iylen,')'
248 write(jplot,'(a,f6.1,a,f6.1,a,f4.2,a)') &
249 ' \\put(',xcur,',',ycur,'){',rcutoff(icut),' \\AA}'
254 write(jplot,'(a,i3,a)') '% Begin cut-off',1,'.'
259 write(jplot,'(4(a,f6.1),a,i3,a)') &
260 ' \\put(',xcur,',',ycur,'){\\framebox(',xbox,',',ybox,'){',&
262 write(jplot,'(2(a,f6.1),2(a,i5),a,f6.1,a)') &
263 ' \\put(',xdraw,',',ydraw,'){\\line(',ideltx,&
264 ',',0,'){',deltx,'}}'
267 write(jplot,'(a,i3,a)') '% Begin cut-off',icut,'.'
270 !d print *,'icut=',icut,' xlen=',xlen,' deltx=',deltx,
271 !d & ' xcur=',xcur,' xdraw=',xdraw
274 ydraw=y(ifirst(j,icut-1),icut)
275 delty=y(ilast(j,icut-1),icut)-y(ifirst(j,icut-1),icut)
277 write(jplot,'(2(a,f6.1),2(a,i5),a,f6.1,a)') &
278 ' \\put(',xdraw,',',ydraw,'){\\line(',0,&
279 ',',idelty,'){',delty,'}}'
287 write(jplot,'(2(a,f6.1),2(a,i5),a,f6.1,a)') &
288 ' \\put(',xdraw,',',ydraw,'){\\line(',ideltx,&
289 ',',0,'){',deltx,'}}'
290 write(jplot,'(4(a,f6.1),a,i3,a)') &
291 ' \\put(',xcur,',',ycur,'){\\framebox(',xbox,',',ybox,'){',&
293 if (icut.lt.ncut) then
295 write(jplot,'(2(a,f6.1),2(a,i5),a,f6.1,a)') &
296 ' \\put(',xdraw,',',ydraw,'){\\line(',ideltx,&
297 ',',0,'){',deltx,'}}'
301 write(jplot,'(a)') '\\end{picture}'
303 END SUBROUTINE PLOTREE
304 !------------------------------------------------------------------------------
305 !------------------------------------------------------------------------------