! 例題 8-11  整数の整数和分解 ［再帰的サブルーチン ］
PROGRAM ex8_11

  IMPLICIT NONE
  INTEGER, ALLOCATABLE :: parts( : )
  INTEGER :: n, i, kind, case

  DO
    PRINT *, 'Case 0 : n into arbitrary positive integers'
    PRINT *, '     1 : n into distinct positive integers'
    PRINT *, 'default: exit'
    WRITE( *, '( A )', ADVANCE = 'NO' ) 'Case ? '
    READ *, case

    IF ( case < 0 .OR. case > 1 ) EXIT

    WRITE ( *, '( A )', ADVANCE = 'NO' ) 'Integer n ? '
    READ *, n

    ALLOCATE ( parts( 1 : n ) )

    i = 0
    kind = 0
    parts = 0
    PRINT *

    CALL partition( n, n )

    DEALLOCATE ( parts )

    PRINT '( 1X, "problem (", I1, ") for n =", I3/ )', case, n

  END DO

CONTAINS

  RECURSIVE SUBROUTINE partition( p, px )

    IMPLICIT NONE
    INTEGER, INTENT( IN ) :: p, px
    INTEGER :: k, ist

    IF ( p == 0 ) THEN
      kind = kind + 1
      PRINT '( 1X, I4, ")", 1X, 80I3 )', kind, parts( 1 : i )
    ELSE
      DO k = px, 1, -1
        ist = i
        i = i + 1
        parts( i ) = k
        CALL partition( p - k, MIN( p - k, k - case ) )
        i = ist
      END DO
    END IF

  END SUBROUTINE partition

END PROGRAM ex8_11