Adam's changes
[unres.git] / source / wham / src-M-Pawel / 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 c      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