source/cluster/wham/src-M/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       if (n.eq.1) then
  21         tabperm(1,1)=1
  22         return
  23       endif
  24       kkk=0
  25       do i=1,n
  26       a(i)=i
  27       enddo
  28    10 print *,(a(i),i=1,n)
  29       kkk=kkk+1
  30       do i=1,n
  31       tabperm(kkk,i)=a(i)
  32 c      write (iout,*) "tututu", kkk
  33       enddo
  34       if(nextp(n,a)) go to 10
  35       return
  36       end
  37
  38       function nextp(n,a)
  39       integer n,a,i,j,k,t
  40       logical nextp
  41       dimension a(n)
  42       i=n-1
  43    10 if(a(i).lt.a(i+1)) go to 20
  44       i=i-1
  45       if(i.eq.0) go to 20
  46       go to 10
  47    20 j=i+1
  48       k=n
  49    30 t=a(j)
  50       a(j)=a(k)
  51       a(k)=t
  52       j=j+1
  53       k=k-1
  54       if(j.lt.k) go to 30
  55       j=i
  56       if(j.ne.0) go to 40
  57       nextp=.false.
  58       return
  59    40 j=j+1
  60       if(a(j).lt.a(i)) go to 40
  61       t=a(i)
  62       a(i)=a(j)
  63       a(j)=t
  64       nextp=.true.
  65       return
  66       end