Sets the number of MC markers launched from each beam_grid cell
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer(kind=Int64), | intent(in) | :: | nr_markers | Approximate total number of markers to launch |
||
real(kind=Float64), | intent(in), | dimension(:,:,:), target | :: | papprox | beam_grid cell weights |
|
integer(kind=Int32), | intent(out), | dimension(:,:,:) | :: | nlaunch | Number of mc markers to launch for each cell: nlaunch(x,y,z) |
subroutine get_nlaunch(nr_markers,papprox, nlaunch)
!+ Sets the number of MC markers launched from each [[libfida:beam_grid]] cell
integer(Int64), intent(in) :: nr_markers
!+ Approximate total number of markers to launch
real(Float64), dimension(:,:,:), target, intent(in) :: papprox
!+ [[libfida:beam_grid]] cell weights
integer(Int32), dimension(:,:,:), intent(out) :: nlaunch
!+ Number of mc markers to launch for each cell: nlaunch(x,y,z)
logical, dimension(beam_grid%nx,beam_grid%ny,beam_grid%nz) :: mask
real(Float64), dimension(beam_grid%ngrid) :: cdf
integer :: c, i, j, k, nc, nm, ind(3)
integer :: nmin = 5
integer, dimension(1) :: randomi
type(rng_type) :: r
real(Float64), pointer :: papprox_ptr(:)
!! Fill in minimum number of markers per cell
nlaunch = 0
mask = papprox.gt.0.0
where(mask)
nlaunch = nmin
endwhere
!! If there are any left over distribute according to papprox
nc = count(mask)
if(nr_markers.gt.(nmin*nc)) then
nm = nr_markers - nmin*nc
!! precalculate cdf to save time
call c_f_pointer(c_loc(papprox), papprox_ptr, [beam_grid%ngrid])
call cumsum(papprox_ptr, cdf)
!! use the same seed for all processes
call rng_init(r, 932117)
do c=1, nm
call randind_cdf(r, cdf, randomi)
call ind2sub(beam_grid%dims, randomi(1), ind)
i = ind(1) ; j = ind(2) ; k = ind(3)
nlaunch(i,j,k) = nlaunch(i,j,k) + 1
enddo
endif
end subroutine get_nlaunch