| 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
|
|---|
