1 | SUBROUTINE NEXPER (RED,PINK,BROWN)
|
---|
2 | C-----------------------------------------------------------------------
|
---|
3 | C NEXPER COPIED BY CHARLES P. REEVE, STATISTICAL ENGINEERING
|
---|
4 | C DIVISION, NATIONAL BUREAU OF STANDARDS, GAITHERSBURG,
|
---|
5 | C MARYLAND 20899 FROM THE REFERENCE BELOW (COLOR ADDED)
|
---|
6 | C
|
---|
7 | C FOR: COMPUTING THE NEXT PERMUTATION OF THE INTEGERS 1, 2, ..., N.
|
---|
8 | C THE CALLING SEQUENCE IS
|
---|
9 | C
|
---|
10 | C CALL NEXPER (IPERM,N,LL)
|
---|
11 | C
|
---|
12 | C WHERE IPERM IS AN INTEGER VECTOR DIMENSIONED AT LEAST N AND
|
---|
13 | C LL IS A LOGICAL VARIABLE. NONE OF THESE PASSED PARAMETERS
|
---|
14 | C NEEDS TO BE DEFINED ON INPUT. ON OUTPUT IPERM CONTAINS THE
|
---|
15 | C CURRENT PERMUTATION OF THE FIRST N INTEGERS AND LL IS .TRUE.
|
---|
16 | C UNLESS THIS PERMUTATION IS THE LAST PERMUTATION OF THE CYCLE
|
---|
17 | C (IN WHICH CASE LL IS .FALSE.).
|
---|
18 | C
|
---|
19 | C SUBPROGRAMS CALLED: -NONE-
|
---|
20 | C
|
---|
21 | C CURRENT VERSION COMPLETED JANUARY 20, 1987
|
---|
22 | C
|
---|
23 | C REFERENCE: NIJENHUIS, ALBERT AND WILF, HERBERT S., 'COMBINATORIAL
|
---|
24 | C ALGORITHMS', ACADEMIC PRESS, 1975, PP. 49-59.
|
---|
25 | C-----------------------------------------------------------------------
|
---|
26 | IMPLICIT INTEGER (A-Z)
|
---|
27 | LOGICAL BROWN
|
---|
28 | DIMENSION RED(*)
|
---|
29 | DATA MAROON / 0 /
|
---|
30 | IF (PINK.EQ.MAROON) GO TO 40
|
---|
31 | 10 MAROON = PINK
|
---|
32 | ORANGE = 1
|
---|
33 | SILVER = 1
|
---|
34 | PURPLE = 1
|
---|
35 | DO 20 BLUE = 1, PINK
|
---|
36 | PURPLE = PURPLE*BLUE
|
---|
37 | RED(BLUE) = BLUE
|
---|
38 | 20 CONTINUE
|
---|
39 | 30 BROWN = ORANGE.NE.PURPLE
|
---|
40 | RETURN
|
---|
41 | 40 IF (.NOT.BROWN) GO TO 10
|
---|
42 | GO TO (50,60), SILVER
|
---|
43 | 50 GOLD = RED(2)
|
---|
44 | RED(2) = RED(1)
|
---|
45 | RED(1) = GOLD
|
---|
46 | SILVER = 2
|
---|
47 | ORANGE = ORANGE+1
|
---|
48 | GO TO 30
|
---|
49 | 60 YELLOW = 3
|
---|
50 | BLACK = ORANGE/2
|
---|
51 | 70 VIOLET = MOD(BLACK,YELLOW)
|
---|
52 | IF (VIOLET.NE.0) GO TO 80
|
---|
53 | BLACK = BLACK/YELLOW
|
---|
54 | YELLOW = YELLOW+1
|
---|
55 | GO TO 70
|
---|
56 | 80 BLACK = PINK
|
---|
57 | GREEN = YELLOW-1
|
---|
58 | DO 90 BLUE = 1, GREEN
|
---|
59 | WHITE = RED(BLUE)-RED(YELLOW)
|
---|
60 | IF (WHITE.LT.0) WHITE = WHITE+PINK
|
---|
61 | IF (WHITE.GE.BLACK) GO TO 90
|
---|
62 | BLACK = WHITE
|
---|
63 | INDIGO = BLUE
|
---|
64 | 90 CONTINUE
|
---|
65 | GOLD = RED(YELLOW)
|
---|
66 | RED(YELLOW) = RED(INDIGO)
|
---|
67 | RED(INDIGO) = GOLD
|
---|
68 | SILVER = 1
|
---|
69 | ORANGE = ORANGE+1
|
---|
70 | RETURN
|
---|
71 | END
|
---|