X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fsrc_MD-M-newcorr%2Fpermut.F;fp=source%2Funres%2Fsrc_MD-M-newcorr%2Fpermut.F;h=724f36c361c9e6c67dbbb01093276d26a911b3cb;hb=cdc95405c49b00f31b9f3fb678aaf9e7dbdcce14;hp=0000000000000000000000000000000000000000;hpb=06073a9f4663b94f47f54fb15dc598740378267b;p=unres.git diff --git a/source/unres/src_MD-M-newcorr/permut.F b/source/unres/src_MD-M-newcorr/permut.F new file mode 100644 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