source/cluster/track.F90

   1       module tracking
   2 !------------------------------------------------------------------------------
   3       use clust_data
   4       implicit none
   5 !------------------------------------------------------------------------------
   6 !      COMMON /HISTORY/
   7       integer :: NCUR(MAX_CUT),IBACK(MAXGR,MAX_CUT)
   8 !      COMMON /PREVIOUS/
   9       integer :: NGRP,LICZP(MAXGR),NCONFP(MAXGR,MAXINGR)
  10 !------------------------------------------------------------------------------
  11 !
  12 !
  13 !------------------------------------------------------------------------------
  14       contains
  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
  23       IF (ICUT.GT.1) THEN
  24 ! Find out what of the previous families the current ones came from.
  25         DO IGR=1,NGR
  26           NCI1=NCONF(IGR,1)
  27           DO JGR=1,NGRP
  28             DO K=1,LICZP(JGR)
  29               IF (NCI1.EQ.NCONFP(JGR,K)) THEN
  30                 IBACK(IGR,ICUT)=JGR
  31                 GOTO 10
  32               ENDIF
  33             ENDDO ! K
  34           ENDDO ! JGR
  35   10      CONTINUE
  36         ENDDO ! IGR
  37       ENDIF ! (ICUT.GT.1)
  38 ! Save current partition for subsequent backtracking.
  39       NCUR(ICUT)=NGR
  40       NGRP=NGR
  41       DO IGR=1,NGR
  42         LICZP(IGR)=LICZ(IGR)
  43         DO K=1,LICZ(IGR)
  44           NCONFP(IGR,K)=NCONF(IGR,K)
  45         ENDDO ! K
  46       ENDDO ! IGR
  47       RETURN
  48       END SUBROUTINE TRACK
  49 !------------------------------------------------------------------------------
  50       SUBROUTINE WRITRACK
  51
  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
  61 !     do icut=2,ncut
  62 !       write (iout,'(a,f10.5)') 'Cut-off',rcutoff(icut)
  63 !       write (iout,'(16i5)') (iback(k,icut),k=1,ncur(icut))
  64 !     enddo
  65 !
  66 ! Print the partition history.
  67 !
  68       DO ICUT=2,NCUT
  69         NCU=NCUR(ICUT)
  70         NCUP=NCUR(ICUT-1)
  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)
  75         DO I=1,NCUP
  76           NPART=0
  77 !d        print *,'i=',i
  78           DO J=1,NCU
  79             IF (IBACK(J,ICUT).EQ.I) THEN
  80               NPART=NPART+1
  81               IPART(NPART,I)=J
  82             ENDIF
  83 !d          print *,'j=',j,' iback=',IBACK(J,ICUT),' npart=',npart
  84           ENDDO ! J
  85           WRITE (iout,'(16I5)') I,(IPART(K,I),K=1,NPART)
  86         ENDDO ! I
  87       ENDDO ! ICUT
  88       RETURN
  89       END SUBROUTINE WRITRACK
  90 !------------------------------------------------------------------------------
  91       SUBROUTINE PLOTREE
  92
  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
 109 !el      external ilen
 110 !
 111 ! Generate the image of the tree (tentatively for LaTeX picture environment).
 112 !
 113 !
 114 ! First untangle the branches of the tree
 115 !
 116       DO I=1,NCUR(1)
 117         ITREE(I,1)=I
 118       ENDDO
 119       DO ICUT=NCUT,2,-1
 120 !
 121 ! Determine the order of families for the (icut)th partition.
 122 !
 123         NCU=NCUR(ICUT)
 124         NCUP=NCUR(ICUT-1)
 125         NPART=0
 126         DO I=1,NCUP
 127           IS=0
 128           IF (I.GT.1) ILAST(I-1,ICUT-1)=NPART
 129           DO J=1,NCU
 130             IF (IBACK(J,ICUT).EQ.I) THEN
 131               NPART=NPART+1
 132               IF (IS.EQ.0) THEN
 133                 IS=1
 134                 IFIRST(I,ICUT-1)=NPART
 135               ENDIF
 136               ITREE(NPART,ICUT)=J
 137             ENDIF
 138           ENDDO ! J
 139         ENDDO ! I
 140         ILAST(NCUP,ICUT-1)=NPART
 141 !d      print *,'i=',i,' ncup=',ncup,' ncu=',ncu,' npart=',npart
 142       ENDDO ! ICUT
 143 ! diagnostic printout
 144 !d    do icut=1,ncut
 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))
 150 !d    enddo
 151 !
 152 ! Propagate the order of families from cut-off #2 to cut-off #n.
 153 !
 154       DO ICUT=1,NCUT-1
 155         DO J=1,NCUR(ICUT)
 156           IFT(J)=IFIRST(J,ICUT)
 157           ILT(J)=ILAST(J,ICUT)
 158         ENDDO ! J
 159         DO J=1,NCUR(ICUT+1)
 160           ITR(J)=ITREE(J,ICUT+1)
 161         ENDDO
 162         DO I=1,NCUR(ICUT)
 163           ITI=ITREE(I,ICUT)
 164 !         write (iout,*) 'icut=',icut,' i=',i,' iti=',iti
 165 !         IF (ITI.NE.I) THEN
 166             JF1=IFT(I)
 167             JF2=IFT(ITI)
 168             JL1=ILT(I)
 169             JL2=ILT(ITI)
 170             JR1=JL1-JF1+1
 171             JR2=JL2-JF2+1
 172 !d          write (iout,*) 'jf1=',jf1,' jl1=',jl1,' jf2=',jf2,
 173 !d   &                     ' jl2=',jl2
 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
 178 ! Update ITREE.
 179             JF11=IFIRST(I,ICUT)
 180 !d          write(iout,*) 'jf11=',jf11
 181             DO J=JF2,JL2
 182 !d            write (iout,*) j,JF11+J-JF2,ITR(J)
 183               ITREE(JF11+J-JF2,ICUT+1)=ITR(J)
 184             ENDDO
 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))
 187 !         ENDIF ! (ITI.NE.I)
 188         ENDDO ! I
 189       ENDDO ! ICUT
 190 ! diagnostic printout
 191 !d    do icut=1,ncut
 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))
 197 !d    enddo
 198 !
 199 ! Generate the y-coordinates of the branches.
 200 !
 201       XLEN=400.0/(ncut-1)
 202       YLEN=600.0
 203       xbox=xlen/4.0
 204       deltx=0.5*(xlen-xbox)
 205       NNC=NCUR(NCUT)
 206       ybox=ylen/(2.0*nnc)
 207       DO J=1,NNC
 208         Y(J,NCUT)=J*YLEN/NNC
 209       ENDDO
 210       DO ICUT=NCUT-1,1,-1
 211         NNC=NCUR(ICUT)
 212         DO J=1,NNC
 213           KF=IFIRST(J,ICUT)
 214           KL=ILAST(J,ICUT)
 215           YY=0.0
 216           DO K=KF,KL
 217             YY=YY+Y(K,ICUT+1)
 218           ENDDO
 219           Y(J,ICUT)=YY/(KL-KF+1)
 220         ENDDO ! J
 221       ENDDO ! ICUT
 222 ! diagnostic output
 223 !d    do icut=1,ncut
 224 !d      write(iout,*) 'Cut-off=',rcutoff(icut)
 225 !d      write(iout,'(8f10.3)') (y(j,icut),j=1,ncur(icut))
 226 !d    enddo
 227 !
 228 ! Generate LaTeX script for tree plot
 229 !
 230       iylen=ylen
 231 #ifdef AIX
 232       call fdate_(fd)
 233 #else
 234       call fdate(fd)
 235 #endif
 236       write(jplot,'(80(1h%))')
 237       write(jplot,'(a)')  '% LaTeX code for minimal-tree plotting.'
 238       write(jplot,'(3a)') '% Created by UNRES_CLUST on ',&
 239         fd(:ilen(fd)),'.'
 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,')'
 245       ycur=ylen+ybox
 246       do icut=ncut,1,-1
 247         xcur=xlen*(icut-1)
 248         write(jplot,'(a,f6.1,a,f6.1,a,f4.2,a)') &
 249          '  \\put(',xcur,',',ycur,'){',rcutoff(icut),' \\AA}'
 250       enddo ! icut
 251       xcur=0.0
 252       xdraw=xcur+xbox
 253       nnc=ncur(1)
 254       write(jplot,'(a,i3,a)') '% Begin cut-off',1,'.'
 255       do j=1,nnc
 256         ydraw=y(j,1)
 257         ycur=ydraw-0.5*ybox
 258         ideltx=deltx
 259         write(jplot,'(4(a,f6.1),a,i3,a)') &
 260          '  \\put(',xcur,',',ycur,'){\\framebox(',xbox,',',ybox,'){',&
 261          itree(j,1),'}}'
 262         write(jplot,'(2(a,f6.1),2(a,i5),a,f6.1,a)') &
 263          '  \\put(',xdraw,',',ydraw,'){\\line(',ideltx,&
 264          ',',0,'){',deltx,'}}'
 265       enddo ! j
 266       do icut=2,ncut
 267         write(jplot,'(a,i3,a)') '% Begin cut-off',icut,'.'
 268         xcur=xlen*(icut-1)
 269         xdraw=xcur-deltx
 270 !d      print *,'icut=',icut,' xlen=',xlen,' deltx=',deltx,
 271 !d   & ' xcur=',xcur,' xdraw=',xdraw
 272         nnc=ncur(icut)
 273         do j=1,ncur(icut-1)
 274           ydraw=y(ifirst(j,icut-1),icut)
 275           delty=y(ilast(j,icut-1),icut)-y(ifirst(j,icut-1),icut)
 276           idelty=delty
 277           write(jplot,'(2(a,f6.1),2(a,i5),a,f6.1,a)') &
 278          '  \\put(',xdraw,',',ydraw,'){\\line(',0,&
 279          ',',idelty,'){',delty,'}}'
 280         enddo
 281         do j=1,nnc
 282           xcur=xlen*(icut-1)
 283           xdraw=xcur-deltx
 284           ydraw=y(j,icut)
 285           ycur=ydraw-0.5*ybox
 286           ideltx=deltx
 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,'){',&
 292            itree(j,icut),'}}'
 293           if (icut.lt.ncut) then
 294             xdraw=xcur+xbox
 295             write(jplot,'(2(a,f6.1),2(a,i5),a,f6.1,a)') &
 296            '  \\put(',xdraw,',',ydraw,'){\\line(',ideltx,&
 297            ',',0,'){',deltx,'}}'
 298           endif
 299         enddo ! j
 300       enddo ! icut
 301       write(jplot,'(a)') '\\end{picture}'
 302       RETURN
 303       END SUBROUTINE PLOTREE
 304 !------------------------------------------------------------------------------
 305 !------------------------------------------------------------------------------
 306       end module tracking