SUBROUTINE gcount(n, apply, ifault)
 
! Code converted using TO_F90 by Alan Miller
! Date: 2003-04-26  Time: 20:20:16

! ALGORITHM AS227  APPL. STATIST. (1987) VOL. 36, NO. 2, pp. 245-9.

! Generates all possible N-bit binary codes, and applies a users
! procedure for each code generated.

! Translated from Algol 60.

IMPLICIT NONE

INTEGER, INTENT(IN)   :: n
INTEGER, INTENT(OUT)  :: ifault

! EXTERNAL apply

INTERFACE
  SUBROUTINE apply(n, change, STATUS)
    IMPLICIT NONE
    INTEGER, INTENT(IN)  :: n, change
    LOGICAL, INTENT(IN)  :: STATUS(n)
  END SUBROUTINE apply
END INTERFACE

! Local variables

INTEGER  :: change, i, tpoint(n)
LOGICAL  :: STATUS(n)

IF (n < 1) THEN
  ifault = 1
  RETURN
END IF
ifault = 0

! Initialize and make first call to user's routine.

DO  i = 1, n
  STATUS(i) = .false.
  tpoint(i) = i + 1
END DO
CALL apply(n, n, STATUS)

! Generate a new code.   The user's routine is called twice each
! cycle; the first time the bit which changes is bit 1.

20 IF (STATUS(1)) THEN
  STATUS(1) = .false.
  change = tpoint(2)
ELSE
  STATUS(1) = .true.
  change = 2
END IF
CALL apply(n, 1, STATUS)

! Check if count exhausted.

IF (change > n) RETURN

IF (STATUS(change)) THEN
  STATUS(change) = .false.
  tpoint(change) = tpoint(change+1)
ELSE
  STATUS(change) = .true.
  tpoint(change) = change + 1
END IF
CALL apply(n, change, STATUS)

GO TO 20
END SUBROUTINE gcount



SUBROUTINE print_comb(n, change, STATUS)
IMPLICIT NONE
INTEGER, INTENT(IN)  :: n, change
LOGICAL, INTENT(IN)  :: STATUS(n)

WRITE(*, '(" ", 4L2)') STATUS
RETURN
END SUBROUTINE print_comb



PROGRAM t_as227
! A simple program to print out the combinations when n = 4.

IMPLICIT NONE

INTEGER  :: n = 4, ifault

INTERFACE
  SUBROUTINE gcount(n, apply, ifault)
    IMPLICIT NONE
    INTEGER, INTENT(IN)   :: n
    INTEGER, INTENT(OUT)  :: ifault
    INTERFACE
      SUBROUTINE apply(n, change, STATUS)
        IMPLICIT NONE
        INTEGER, INTENT(IN)  :: n, change
        LOGICAL, INTENT(IN)  :: STATUS(n)
      END SUBROUTINE apply
    END INTERFACE
  END SUBROUTINE gcount

  SUBROUTINE print_comb(n, change, STATUS)
    IMPLICIT NONE
    INTEGER, INTENT(IN)  :: n, change
    LOGICAL, INTENT(IN)  :: STATUS(n)
  END SUBROUTINE print_comb
END INTERFACE

CALL gcount(n, print_comb, ifault)

STOP
END PROGRAM t_as227