get_nlaunch Subroutine

public subroutine get_nlaunch(nr_markers, papprox, nlaunch)

Sets the number of MC markers launched from each beam_grid cell

Arguments

TypeIntentOptionalAttributesName
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)


Calls

proc~~get_nlaunch~~CallsGraph proc~get_nlaunch get_nlaunch proc~cumsum cumsum proc~get_nlaunch->proc~cumsum proc~rng_init rng_init proc~get_nlaunch->proc~rng_init interface~randind_cdf randind_cdf proc~get_nlaunch->interface~randind_cdf proc~ind2sub ind2sub proc~get_nlaunch->proc~ind2sub proc~rng_seed rng_seed proc~rng_init->proc~rng_seed proc~my_rank my_rank proc~rng_init->proc~my_rank

Called by

proc~~get_nlaunch~~CalledByGraph proc~get_nlaunch get_nlaunch proc~dcx dcx proc~dcx->proc~get_nlaunch proc~fida_f fida_f proc~fida_f->proc~get_nlaunch proc~halo halo proc~halo->proc~get_nlaunch proc~fida_weights_mc fida_weights_mc proc~fida_weights_mc->proc~get_nlaunch proc~npa_f npa_f proc~npa_f->proc~get_nlaunch program~fidasim fidasim program~fidasim->proc~dcx program~fidasim->proc~fida_f program~fidasim->proc~halo program~fidasim->proc~fida_weights_mc program~fidasim->proc~npa_f

Contents

Source Code


Source Code

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