source/cluster/wham/src-M/bakup/permut.f

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