get_nlaunch_pass_grid Subroutine

public subroutine get_nlaunch_pass_grid(nr_markers, papprox, nlaunch)

Sets the number of MC markers launched from each pass_grid cell

Arguments

Type IntentOptional AttributesName
integer(kind=Int64), intent(in) :: nr_markers

Approximate total number of markers to launch

real(kind=Float64), intent(in), dimension(:,:,:):: papprox

pass_grid cell weights

integer(kind=Int32), intent(out), dimension(:,:,:):: nlaunch

Number of mc markers to launch for each cell: nlaunch(r,z,phi)


Calls

proc~~get_nlaunch_pass_grid~~CallsGraph proc~get_nlaunch_pass_grid get_nlaunch_pass_grid proc~rng_init rng_init proc~get_nlaunch_pass_grid->proc~rng_init interface~randind_cdf randind_cdf proc~get_nlaunch_pass_grid->interface~randind_cdf 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_pass_grid~~CalledByGraph proc~get_nlaunch_pass_grid get_nlaunch_pass_grid proc~pnpa_f pnpa_f proc~pnpa_f->proc~get_nlaunch_pass_grid proc~pfida_f pfida_f proc~pfida_f->proc~get_nlaunch_pass_grid program~fidasim fidasim program~fidasim->proc~pnpa_f program~fidasim->proc~pfida_f

Contents

Source Code


Source Code

subroutine get_nlaunch_pass_grid(nr_markers,papprox, nlaunch)
    !+ Sets the number of MC markers launched from each [[libfida:pass_grid]] cell
    integer(Int64), intent(in)                    :: nr_markers
        !+ Approximate total number of markers to launch
    real(Float64), dimension(:,:,:), intent(in)   :: papprox
        !+ [[libfida:pass_grid]] cell weights
    integer(Int32), dimension(:,:,:), intent(out) :: nlaunch
        !+ Number of mc markers to launch for each cell: nlaunch(r,z,phi)

    logical, dimension(pass_grid%nr,pass_grid%nz,pass_grid%nphi) :: mask
    real(Float64), dimension(pass_grid%ngrid) :: cdf
    integer, dimension(1) :: randomi
    type(rng_type) :: r
    integer :: c, i, j, k, nc, nm, ind(3)
    integer :: nmin = 5

    !! 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 cumsum(reshape(papprox,[pass_grid%ngrid]), 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(pass_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_pass_grid