s_dat_sample_n Subroutine

subroutine s_dat_sample_n(m, n, mask)

! ==== Description
!! Subroutine for sampling a rank 1 array. It shuffles indeces
!! using the forward Fisher-Yates algorithm (as needed given n),
!! then generates an index mask from it.
!! The mask can simply be applied using the pack intrinsic function:
!! new_array = pack (old_array, mask)

! ==== Declarations
  integer(i4), intent(in)  :: m       !! size of population (array)
  integer(i4), intent(in)  :: n       !! size of sample
  logical    , intent(out) :: mask(m) !! index mask for sampled data
  integer(i4)              :: idx(m)  !! index mask for sampled data
  integer(i4)              :: i, j, k
  real(wp)                 :: r

! ==== Instructions

! ---- handle input and initialise

  ! check if size is valid
  if (n .lt. 0 .or. n .gt. m) then
     ! write error message and assign false if invalid
     call s_err_print(fsml_error(4))
     mask = .false.
     return
  endif

  ! build indeces
  do i = 1, m
     idx(i) = i
  enddo

! ---- create subsample mask

  ! partial Fisher-Yates shuffle
  do i = 1, n
     call random_number(r)
     j = i + int(r * (m - i + 1))
     k = idx(i)
     idx(i) = idx(j)
     idx(j) = k
  enddo

  ! create mask
  mask = .false.
  do i = 1, n
     mask(idx(i)) = .true.
  enddo

end subroutine s_dat_sample_n