!-----  Ex8_5: 抽選を行うサブルーチン -----
!        n1 = 応募者数， n2= 当選者数， kk : 当選者番号
   SUBROUTINE chusen(kk, n1, n2)
      INTEGER, INTENT(IN) :: n1, n2
      INTEGER, INTENT(OUT) :: kk(n1)
      INTEGER :: i, ir, j
      REAL :: x
      kk = (/ ( i, i = 1, n1) /)
      PRINT*,'乱数発生のシード（なるべく大きい整数）を入れてください：'
      READ*, ir
      DO i = 1, MIN(n1 ,n2)
         CALL ran(ir, x)
         j = i + INT( x*(n1 - i + 1) )
         CALL swap( kk(j), kk(i) )
      END DO
   END SUBROUTINE
!-----   入れ替え
   SUBROUTINE swap(i, j)
      INTEGER, INTENT(INOUT) :: i, j
      INTEGER :: k
         k = i; i = j; j = k
   END SUBROUTINE
!-----   乱数発生
   SUBROUTINE ran(i, r)
      INTEGER, INTENT(INOUT):: i
      REAL, INTENT(OUT) :: r
      INTEGER, PARAMETER :: mask = 2147483647, a = 48828125
         i = IAND( a*i, mask )
         r = REAL(i)/REAL(mask)
   END SUBROUTINE
!-----   入出力
   PROGRAM main
      INTEGER, ALLOCATABLE :: number(:)
      INTEGER :: n, m, i
      PRINT*, '応募者数は？';   READ*, n
      PRINT*, '当選者数は？';   READ*, m
      ALLOCATE( number(n) )
      CALL chusen( number, n, m )
!-----   出力
      PRINT *,' 順位    番号'
      DO i = 1, MIN(n, m)
         PRINT '(2X, I4, I8 )', i, number(i)
      END DO
   END