source/wham/src-M-homology/permut.F

   1       subroutine permut(isym)
   2       implicit real*8 (a-h,o-z)
   3       include 'DIMENSIONS'
   4       include 'DIMENSIONS.FREE'
   5       include 'COMMON.LOCAL'
   6       include 'COMMON.VAR'
   7       include 'COMMON.CHAIN'
   8       include 'COMMON.INTERACT'
   9       include 'COMMON.IOUNITS'
  10       include 'COMMON.GEO'
  11 c      include 'COMMON.NAMES'
  12       include 'COMMON.CONTROL'
  13 c      include 'COMMON.DISTFIT'
  14 c      include 'COMMON.SETUP'
  15       integer n,a
  16       logical nextp
  17       external nextp
  18       dimension a(isym)
  19 c      parameter(n=symetr)
  20       n=isym
  21       if (n.eq.1) then
  22         tabperm(1,1)=1
  23         return
  24       endif
  25       kkk=0
  26       do i=1,n
  27       a(i)=i
  28       enddo
  29    10 print *,(a(i),i=1,n)
  30       kkk=kkk+1
  31       do i=1,n
  32       tabperm(kkk,i)=a(i)
  33 c      write (iout,*) "tututu", kkk
  34       enddo
  35       if(nextp(n,a)) go to 10
  36       return
  37       end
  38
  39       function nextp(n,a)
  40       integer n,a,i,j,k,t
  41       logical nextp
  42       dimension a(n)
  43       i=n-1
  44    10 if(a(i).lt.a(i+1)) go to 20
  45       i=i-1
  46       if(i.eq.0) go to 20
  47       go to 10
  48    20 j=i+1
  49       k=n
  50    30 t=a(j)
  51       a(j)=a(k)
  52       a(k)=t
  53       j=j+1
  54       k=k-1
  55       if(j.lt.k) go to 30
  56       j=i
  57       if(j.ne.0) go to 40
  58       nextp=.false.
  59       return
  60    40 j=j+1
  61       if(a(j).lt.a(i)) go to 40
  62       t=a(i)
  63       a(i)=a(j)
  64       a(j)=t
  65       nextp=.true.
  66       return
  67       end