source/fragments/klapaucjusz-longest.f

   1       parameter (maxmodel=20)
   2       parameter (maxres=1000)
   3       character*32 model(maxmodel)
   4       integer imodel(maxmodel)
   5       integer ifragpair(maxres,maxmodel,maxmodel),
   6      &    ifragpair_new(maxres,maxmodel,maxmodel),
   7      & iflag(maxres),isumfmax(maxmodel),kmax(maxmodel),
   8      & isumf(maxmodel),isumfmaxmin(maxmodel),kmaxmin(maxmodel),
   9      & jmaxmin(maxmodel),isump(maxmodel),ifragpair_temp(maxres),
  10      & ifragpair_temp1(maxres),ninclust(maxmodel),nlenclust(maxmodel),
  11      & icluster(maxmodel,maxmodel),ifrag(maxres,maxmodel)
  12       logical overlap
  13
  14       nmodel=5
  15       nres=114
  16       ifragpair_new=0
  17       lencut=7
  18
  19       do i=1,nmodel
  20         do j=1,nmodel
  21           if (i.eq.j) cycle
  22           read(*,'(a32,33x,1000i1)')model(i),(ifragpair(k,i,j),k=1,nres)
  23         enddo
  24       enddo
  25       do i=1,nmodel
  26         do j=i+1,nmodel
  27           write(*,'(2a32,1000i1)')model(i),model(j),
  28      &    (ifragpair(k,i,j),k=1,nres)
  29         enddo
  30       enddo
  31       isumcut=100
  32       iclust=0
  33       DO WHILE (isumcut.ge.lencut)
  34 c search the longest fragment (number 1)
  35       iflag=0
  36       isummax=0
  37       nfrag=0
  38       do i=1,nmodel
  39         do j=1,i-1
  40 c          write(*,'(2a32,1000i1)')model(i),model(j),(ifragpair(k,i,j)
  41 c     &       -ifragpair(k,j,i),k=1,nres)
  42           isump=0
  43           do k=1,nres
  44             kk = ifragpair(k,i,j)
  45             if (kk.gt.0) isump(kk)=isump(kk)+1
  46             if (kk.gt.nfrag) nfrag=kk
  47           enddo
  48           isum=0
  49           do k=1,nfrag
  50             if (isump(k).gt.isum) then
  51               isum=isump(k)
  52               kk=k
  53             endif
  54           enddo
  55 c          write(*,'(2a32,i10)')model(i),model(j),isum
  56           if (isum.gt.isummax) then
  57             isummax=isum
  58             imodel(1)=i
  59             imodel(2)=j
  60             kfmax=kk
  61           endif
  62         enddo
  63       enddo
  64       write (*,*) "nfrag",nfrag," kfmax",kfmax
  65 c      icut = max0(isummax*2/3,lencut)
  66       icut = lencut
  67       nflag=2
  68       iflag(imodel(1))=i
  69       iflag(imodel(2))=j
  70 c      write(*,*)"Maximum"
  71 c      write(*,'(2a32,i10)')model(imodel(1)),model(imodel(2)),isummax
  72       overlap=.true.
  73       i1 = imodel(1)
  74       i2 = imodel(2)
  75       isumcut=0
  76       do while (overlap)
  77         do i=1,nmodel
  78           if (iflag(i).gt.0) cycle
  79           do j=1,nflag
  80             jj = imodel(j)
  81             isumf=0
  82             do k=1,nres
  83               kk = ifragpair(k,i,jj)
  84               if (ifragpair(k,i1,i2).ne.kfmax .or. kk.eq.0) cycle
  85               isumf(kk)=isumf(kk)+1
  86             enddo
  87             isumfmax(j)=0
  88             do k=1,nfrag
  89               if (isumf(k).gt.isumfmax(j)) then
  90                 isumfmax(j)=isumf(k)
  91                 kmax(j)=k
  92               endif
  93             enddo
  94           enddo ! j
  95           isumfmaxmin(i)=1000
  96           kmaxmin(i)=0
  97           jmaxmin(i)=0
  98           do j=1,nflag
  99             if (isumfmax(j).lt.isumfmaxmin(i)) then
 100               isumfmaxmin(i)=isumfmax(j)
 101               kmaxmin(i)=kmax(j)
 102               jmaxmin(i)=imodel(j)
 103             endif
 104           enddo
 105         enddo ! i
 106         isumfmaxminmax=0
 107         kmaxminmax=0
 108         imaxminmax=0
 109         jmaxminmax=0
 110         do i=1,nmodel
 111           if (iflag(i).gt.0) cycle
 112           if (isumfmaxmin(i).gt.isumfmaxminmax) then
 113             isumfmaxminmax=isumfmaxmin(i)
 114             imaxminmax=i
 115             kmaxminmax=kmaxmin(i)
 116             jmaxminmax=jmaxmin(i)
 117           endif
 118         enddo
 119         print *,"isumfmaxminmax",isumfmaxminmax," icut",icut
 120         if (isumfmaxminmax.lt.icut) then
 121           overlap=.false.
 122         else
 123           isumcut = isumfmaxminmax
 124           iimod=imaxminmax
 125           jjmod=jmaxminmax
 126           kkmod=kmaxminmax
 127           nflag=nflag+1
 128           iflag(imaxminmax)=imaxminmax
 129           imodel(nflag)=imaxminmax
 130 c          write(*,'(2a32,i10)')model(imodel(1)),model(imodel(2)),isummax
 131 c          write(*,'(1000i1)')(ifragpair(k,imodel(1),imodel(2)),k=1,nres)
 132           write(*,*) "isumfmaxminmax",isumfmaxminmax
 133           print *,"kmaxminmax",kmaxminmax
 134           write(*,'(a32)')(model(imodel(i)),i=1,nflag)
 135           write(*,'(1000i1)')
 136      &     (ifragpair(k,imaxminmax,jmaxminmax),k=1,nres)
 137           do k=1,nres
 138             ifragpair_temp(k)=ifragpair(k,imaxminmax,jmaxminmax)
 139             ifragpair_temp1(k)=ifragpair(k,i1,i2)
 140           enddo
 141           do i=1,nflag
 142             do j=1,i-1
 143               ii = imodel(i)
 144               jj = imodel(j)
 145               do k=1,nres
 146                 if (ifragpair_temp(k).eq.kmaxminmax .and.
 147      &           ifragpair_temp1(k).eq.kfmax) then
 148                   ifragpair(k,ii,jj)=0
 149                   ifragpair(k,jj,ii)=0
 150                 endif
 151               enddo
 152             enddo
 153           enddo
 154          do i=1,nmodel
 155            do j=i+1,nmodel
 156              write(*,'(2a32,1000i1)')model(i),model(j),
 157      &       (ifragpair(k,i,j),k=1,nres)
 158            enddo
 159          enddo
 160         endif
 161       enddo ! while
 162       print *,"iimod",iimod," jjmod",jjmod," kkmod",kkmod,
 163      &   " isumcut",isumcut
 164       if (isumcut.ge.icut) then
 165         nclust=nclust+1
 166         print *,"cluster",nclust
 167         ninclust(nclust)=nflag
 168         nlenclust(nclust)=isumcut
 169         do i=1,nflag
 170           icluster(i,nclust)=imodel(i)
 171         enddo
 172         ii=0
 173         do k=1,nres
 174           if (ifragpair_temp(k).eq.kkmod .and.
 175      &     ifragpair_temp1(k).eq.kfmax) then
 176             ii=ii+1
 177             print *,k
 178             ifrag(ii,nclust)=k
 179           endif
 180         enddo
 181         if (ii.ne.nlenclust(nclust)) write(*,*) "CHUJ NASTAPIL!!!",
 182      &    ii,nlenclust(nclust)
 183         do i=1,nflag
 184           do j=1,i-1
 185             do k=1,nres
 186               if (ifragpair_temp(k).eq.kkmod .and.
 187      &           ifragpair_temp1(k).eq.kfmax) then
 188                 ifragpair_new(k,imodel(i),imodel(j))=nclust
 189                 ifragpair_new(k,imodel(j),imodel(i))=nclust
 190               endif
 191             enddo
 192           enddo
 193         enddo
 194       endif
 195       ENDDO ! while
 196       do i=1,nmodel
 197         do j=i+1,nmodel
 198           write(*,'(2a32,1000i1)')model(i),model(j),
 199      &      (ifragpair_new(k,i,j),k=1,nres)
 200         enddo
 201       enddo
 202       write (*,*) "nclust",nclust
 203       do i=1,nclust
 204         write(*,*) "Cluster",i," ninclust",ninclust(i)
 205         write(*,'(a32)') (model(icluster(j,i)),j=1,ninclust(i))
 206         write(*,'(i5)') (ifrag(j,i),j=1,nlenclust(i))
 207       enddo
 208       end