Note that the following implementation is a faithful reproduction of the NEXPER algorithm in the book Combinatorial Algorithms For Computers and Calculators by Nijenhuis & Wilf. However, the implementation given in the text has been updated to Fortran 95.

SUBROUTINE NEXPER(N, A, MTC, EVEN)
INTEGER N
INTEGER, DIMENSION(N) :: A
INTEGER S, D, NM3, IA, I1, L
LOGICAL MTC, EVEN
    IF (MTC) GOTO 10
    NM3 = N-3
    DO 1 I=1,N
1   A(I)=I
    MTC=.TRUE.
5   EVEN=.TRUE.
    IF(N .EQ. 1) GOTO 8
6   IF(A(N) .NE. 1 .OR. A(1) .NE. 2+MOD(N,2)) RETURN
    IF(N .LE. 3) GOTO 8
    DO 7 I=1,NM3
    IF(A(I+1) .NE. A(I)+1) RETURN
7   CONTINUE
8   MTC=.FALSE.
    RETURN
10  IF(N .EQ. 1) GOTO 27
    IF(.NOT. EVEN) GOTO 20
    IA=A(1)
    A(1)=A(2)
    A(2)=IA
    EVEN=.FALSE.
    GOTO 6
20  S=0
    DO 26 I1=2,N
25  IA=A(I1)
    I=I1-1
    D=0
    DO 30 J=1,I
30  IF(A(J) .GT. IA) D=D+1
    S=D+S
    IF(D .NE. I*MOD(S,2)) GOTO 35
26  CONTINUE
27  A(1)=0
    GOTO 8
35  M=MOD(S+1,2)*(N+1)
    DO 40 J=1,I
    IF(ISIGN(1,A(J)-IA) .EQ. ISIGN(1,A(J)-M)) GOTO 40
    M=A(J)
    L=J
40  CONTINUE
    A(L)=IA
    A(I1)=M
    EVEN=.TRUE.
    RETURN
END

SUBROUTINE TESTNEXPER
    INTEGER, DIMENSION(5) :: IN
    LOGICAL MTC
    LOGICAL EVEN
    DO 10 I = 1, 5
    IN(I) = I
10  CONTINUE
    MTC = .FALSE.
20  CONTINUE
    CALL NEXPER (5, IN, MTC, EVEN)
    DO 30 I = 1, 5
        WRITE (*,"(I2), ",advance="no") IN(I)
30  CONTINUE
    PRINT *
    IF (MTC) GOTO 20
END