source/unres/src-HCD-5D/chain_symmetry.F

   1       subroutine chain_symmetry(nchain,nres,itype,chain_border,
   2      &    chain_length,npermchain,tabpermchain)
   3 c
   4 c Determine chain symmetry. nperm is the number of permutations and
   5 c tabperchain contains the allowed permutations of the chains.
   6 c
   7       implicit none
   8       include "DIMENSIONS"
   9       include "COMMON.IOUNITS"
  10       include "COMMON.CONTROL"
  11       integer nchain,nres,itype(nres),chain_border(2,maxchain),
  12      &  chain_length(nchain),itemp(maxchain),
  13      &  npermchain,tabpermchain(maxchain,maxperm),
  14      &  tabperm(maxchain,maxperm),mapchain(maxchain),
  15      &  iequiv(maxchain,maxres),iflag(maxres)
  16       integer i,j,k,l,ii,nchain_group,nequiv(maxchain),iieq,
  17      &  nperm,npermc,ind
  18       if (nchain.eq.1) then
  19         npermchain=1
  20         tabpermchain(1,1)=1
  21 c        print*,"npermchain",npermchain," tabpermchain",tabpermchain(1,1)
  22         return
  23       endif
  24 c
  25 c Look for equivalent chains
  26 c
  27 #ifdef DEBUG
  28       write(iout,*) "nchain",nchain
  29       do i=1,nchain
  30         write(iout,*) "chain",i," from",chain_border(1,i),
  31      &      " to",chain_border(2,i)
  32         write(iout,*)
  33      &   "sequence ",(itype(j),j=chain_border(1,i),chain_border(2,i))
  34       enddo
  35 #endif
  36       do i=1,nchain
  37         iflag(i)=0
  38       enddo
  39       nchain_group=0
  40       do i=1,nchain
  41         if (iflag(i).gt.0) cycle
  42         iflag(i)=1
  43         nchain_group=nchain_group+1
  44         iieq=1
  45         iequiv(iieq,nchain_group)=i
  46         if (symetr.eq.1) then
  47         do j=i+1,nchain
  48           if (iflag(j).gt.0.or.chain_length(i).ne.chain_length(j)) cycle
  49 c          k=0
  50 c          do while(k.lt.chain_length(i) .and.
  51 c     &     itype(chain_border(1,i)+k).eq.itype(chain_border(1,j)+k))
  52           do k=0,chain_length(i)-1
  53 c            k=k+1
  54             if (itype(chain_border(1,i)+k).ne.
  55      &          itype(chain_border(1,j)+k)) exit
  56           enddo
  57           if (k.lt.chain_length(i)) cycle
  58           iflag(j)=1
  59           iieq=iieq+1
  60           iequiv(iieq,nchain_group)=j
  61         enddo
  62         endif
  63         nequiv(nchain_group)=iieq
  64       enddo
  65       write(iout,*) "Number of equivalent chain groups:",nchain_group
  66       write(iout,*) "Equivalent chain groups"
  67       do i=1,nchain_group
  68         write(iout,*) "group",i," #members",nequiv(i)," chains",
  69      &      (iequiv(j,i),j=1,nequiv(i))
  70       enddo
  71       ind=0
  72       do i=1,nchain_group
  73         do j=1,nequiv(i)
  74           ind=ind+1
  75           mapchain(ind)=iequiv(j,i)
  76         enddo
  77       enddo
  78       write (iout,*) "mapchain"
  79       do i=1,nchain
  80         write (iout,*) i,mapchain(i)
  81       enddo
  82       ii=0
  83       do i=1,nchain_group
  84         call permut(nequiv(i),nperm,tabperm)
  85         if (ii.eq.0) then
  86           ii=nequiv(i)
  87           npermchain=nperm
  88           do j=1,nperm
  89             do k=1,ii
  90               tabpermchain(k,j)=iequiv(tabperm(k,j),i)
  91             enddo
  92           enddo
  93         else
  94           npermc=npermchain
  95           npermchain=npermchain*nperm
  96           ind=0
  97           do k=1,nperm
  98             do j=1,npermc
  99               ind=ind+1
 100               do l=1,ii
 101                 tabpermchain(l,ind)=tabpermchain(l,j)
 102               enddo
 103               do l=1,nequiv(i)
 104                 tabpermchain(ii+l,ind)=iequiv(tabperm(l,k),i)
 105               enddo
 106             enddo
 107           enddo
 108           ii=ii+nequiv(i)
 109         endif
 110       enddo
 111       do i=1,npermchain
 112         do j=1,nchain
 113           itemp(mapchain(j))=tabpermchain(j,i)
 114         enddo
 115         do j=1,nchain
 116           tabpermchain(j,i)=itemp(j)
 117         enddo
 118       enddo
 119       write(iout,*) "Number of chain permutations",npermchain
 120       write(iout,*) "Permutations"
 121       do i=1,npermchain
 122         write(iout,'(20i4)') (tabpermchain(j,i),j=1,nchain)
 123       enddo
 124       return
 125       end
 126 c---------------------------------------------------------------------
 127       integer function tperm(i,iperm,tabpermchain)
 128       implicit none
 129       include 'DIMENSIONS'
 130       integer i,iperm
 131       integer tabpermchain(maxchain,maxperm)
 132       if (i.eq.0) then
 133         tperm=0
 134       else
 135         tperm=tabpermchain(i,iperm)
 136       endif
 137       return
 138       end