s_dat_sample_p Subroutine

subroutine s_dat_sample_p(m, p, mask)

! ==== Description
!! Subroutine for sampling a rank 1 array using Poisson sampling
!! (subjecting individual elements independently to Bernoulli experiments),
!! then generates an index mask for sampling.
!! 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)
  real(wp)   , intent(in)  :: p       !! inclusion probability
  logical    , intent(out) :: mask(m) !! index mask for sampled data
  integer(i4)              :: i
  real(wp)                 :: r

! ==== Instructions

! ---- handle input and initialise

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

  ! check if value is valid
  if (p .lt. 0.0_wp .or. p .gt. 1.0_wp) then
     ! write error message and assign false if invalid
     call s_err_print(fsml_error(1))
     mask = .false.
     return
  endif

! ---- create subsample mask

  ! Poisson subsampling
  do i = 1, m
     call random_number(r)
     mask(i) = (r .lt. p)
  enddo

end subroutine s_dat_sample_p