! 抽選を行うサブルーチン
! n1 = 応募者数, n2 = 当選者数, kk : 当選者番号
SUBROUTINE chusen( kk, n1, n2 )

  IMPLICIT NONE
  INTEGER, INTENT(IN) :: n1, n2
  INTEGER, INTENT(OUT) :: kk(n1)
  INTEGER :: i, ir, j
  REAL :: x

  kk = (/ ( i, i = 1, n1) /)
  PRINT '(1X, A)', '乱数発生のシード（なるべく大きい整数）を入れてください：'
  READ *, ir

  DO i = 1, min( n1, n2 )
    CALL ran( ir, x )                 ! 0 < x < 1 の一様乱数
    j = i + INT( x * ( n1 - i + 1 ) ) ! 残りのカードから任意抽出
    CALL swap( kk(j), kk(i) )         ! これを i 番目としておく
  END DO

END SUBROUTINE chusen

! 入れ替え
SUBROUTINE swap( i, j )

  IMPLICIT NONE
  INTEGER, INTENT(INOUT) :: i, j
  INTEGER :: k

  k = i
  i = j
  j = k

END SUBROUTINE swap

! 乱数発生
SUBROUTINE ran( i, r )

  IMPLICIT NONE
  INTEGER, INTENT(INOUT):: i
  INTEGER, PARAMETER :: mask = 2147483647, a = 48828125
  REAL, PARAMETER :: rmax = 2.147483648E9
  REAL, INTENT(OUT) :: r

  i = IAND( a * i, mask )
  r = REAL( i ) / rmax

END SUBROUTINE ran

! 入出力
PROGRAM main

  IMPLICIT NONE
  INTEGER, ALLOCATABLE :: number(:)
  INTEGER :: n, m, i

  PRINT '(1X, A)', '応募者数は？'
  READ *, n
  PRINT '(1X, A)', '当選者数は？'
  READ *, m

  ALLOCATE( number(1:n) )

  CALL chusen( number, n, m )

  ! 出力
  PRINT '(1X, A)', ' 順位    番号'
  DO i = 1, MIN( n, m )
    PRINT '(2X, I4, I8)', i, number(i)
  END DO

END PROGRAM main