Merge branch 'lipid' of mmka.chem.univ.gda.pl:unres into lipid

[unres.git] / source / unres / src_MD-M-newcorr / permut.F

diff --git a/source/unres/src_MD-M-newcorr/permut.F b/source/unres/src_MD-M-newcorr/permut.F
new file mode 100644 (file)
index 0000000..724f36c
--- /dev/null
+++ b/source/unres/src_MD-M-newcorr/permut.F
@@ -0,0 +1,66 @@
+      subroutine permut(isym)
+      implicit real*8 (a-h,o-z) 
+      include 'DIMENSIONS'
+      include 'COMMON.LOCAL'
+      include 'COMMON.VAR'
+      include 'COMMON.CHAIN'
+      include 'COMMON.INTERACT'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.GEO'
+      include 'COMMON.NAMES'
+      include 'COMMON.CONTROL'
+c      include 'COMMON.DISTFIT'
+c      include 'COMMON.SETUP'
+      integer n,a
+      logical nextp
+      external nextp
+      dimension a(isym)
+c      parameter(n=symetr)
+      n=isym
+      if (n.eq.1) then
+        tabperm(1,1)=1
+        return
+      endif
+      kkk=0
+      do i=1,n
+      a(i)=i
+      enddo
+   10 print *,(a(i),i=1,n)
+      kkk=kkk+1
+      do i=1,n
+      tabperm(kkk,i)=a(i)
+c      write (iout,*) "tututu", kkk
+      enddo
+      if(nextp(n,a)) go to 10
+      return
+      end
+ 
+      function nextp(n,a)
+      integer n,a,i,j,k,t
+      logical nextp
+      dimension a(n)
+      i=n-1
+   10 if(a(i).lt.a(i+1)) go to 20
+      i=i-1
+      if(i.eq.0) go to 20
+      go to 10
+   20 j=i+1
+      k=n
+   30 t=a(j)
+      a(j)=a(k)
+      a(k)=t
+      j=j+1
+      k=k-1
+      if(j.lt.k) go to 30
+      j=i
+      if(j.ne.0) go to 40
+      nextp=.false.
+      return
+   40 j=j+1
+      if(a(j).lt.a(i)) go to 40
+      t=a(i)
+      a(i)=a(j)
+      a(j)=t
+      nextp=.true.
+      return
+      end