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

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