mc_fastion_pass_grid Subroutine

public subroutine mc_fastion_pass_grid(ind, fields, eb, ptch, denf, output_coords)

Samples a Guiding Center Fast-ion distribution function at a given pass_grid index

Arguments

Type IntentOptional AttributesName
integer, intent(in), dimension(3):: ind

pass_grid index

type(LocalEMFields), intent(out) :: fields

Electromagnetic fields at the guiding center

real(kind=Float64), intent(out) :: eb

Energy of the fast ion

real(kind=Float64), intent(out) :: ptch

Pitch of the fast ion

real(kind=Float64), intent(out) :: denf

Fast-ion density at guiding center

integer, intent(in), optional :: output_coords

Indicates coordinate system of fields. Beam grid (0), machine (1) and cylindrical (2)


Calls

proc~~mc_fastion_pass_grid~~CallsGraph proc~mc_fastion_pass_grid mc_fastion_pass_grid proc~get_fields get_fields proc~mc_fastion_pass_grid->proc~get_fields interface~randu randu proc~mc_fastion_pass_grid->interface~randu proc~cyl_to_uvw cyl_to_uvw proc~mc_fastion_pass_grid->proc~cyl_to_uvw proc~get_distribution get_distribution proc~mc_fastion_pass_grid->proc~get_distribution interface~randind randind proc~mc_fastion_pass_grid->interface~randind proc~calc_perp_vectors calc_perp_vectors proc~get_fields->proc~calc_perp_vectors proc~uvw_to_xyz uvw_to_xyz proc~get_fields->proc~uvw_to_xyz proc~in_plasma in_plasma proc~get_fields->proc~in_plasma proc~xyz_to_uvw xyz_to_uvw proc~get_fields->proc~xyz_to_uvw interface~interpol interpol proc~get_distribution->interface~interpol proc~get_distribution->proc~xyz_to_uvw proc~interpol3d_arr interpol3D_arr interface~interpol->proc~interpol3d_arr proc~interpol2d_2d_arr interpol2D_2D_arr interface~interpol->proc~interpol2d_2d_arr proc~interpol2d_arr interpol2D_arr interface~interpol->proc~interpol2d_arr proc~interpol1d_arr interpol1D_arr interface~interpol->proc~interpol1d_arr proc~interpol3d_2d_arr interpol3D_2D_arr interface~interpol->proc~interpol3d_2d_arr proc~in_plasma->proc~cyl_to_uvw proc~in_plasma->proc~xyz_to_uvw interface~interpol_coeff interpol_coeff proc~in_plasma->interface~interpol_coeff proc~cyl_interpol3d_coeff cyl_interpol3D_coeff interface~interpol_coeff->proc~cyl_interpol3d_coeff proc~interpol1d_coeff interpol1D_coeff interface~interpol_coeff->proc~interpol1d_coeff proc~interpol2d_coeff_arr interpol2D_coeff_arr interface~interpol_coeff->proc~interpol2d_coeff_arr proc~interpol2d_coeff interpol2D_coeff interface~interpol_coeff->proc~interpol2d_coeff proc~cyl_interpol3d_coeff_arr cyl_interpol3D_coeff_arr interface~interpol_coeff->proc~cyl_interpol3d_coeff_arr proc~interpol1d_coeff_arr interpol1D_coeff_arr interface~interpol_coeff->proc~interpol1d_coeff_arr proc~interpol3d_arr->interface~interpol_coeff proc~interpol2d_2d_arr->interface~interpol_coeff proc~interpol2d_arr->interface~interpol_coeff proc~interpol1d_arr->interface~interpol_coeff proc~interpol3d_2d_arr->interface~interpol_coeff proc~cyl_interpol3d_coeff->proc~interpol2d_coeff proc~interpol2d_coeff_arr->proc~interpol2d_coeff proc~cyl_interpol3d_coeff_arr->proc~cyl_interpol3d_coeff proc~cyl_interpol3d_coeff_arr->proc~interpol2d_coeff proc~interpol1d_coeff_arr->proc~interpol1d_coeff

Called by

proc~~mc_fastion_pass_grid~~CalledByGraph proc~mc_fastion_pass_grid mc_fastion_pass_grid proc~pnpa_f pnpa_f proc~pnpa_f->proc~mc_fastion_pass_grid proc~pfida_f pfida_f proc~pfida_f->proc~mc_fastion_pass_grid program~fidasim fidasim program~fidasim->proc~pnpa_f program~fidasim->proc~pfida_f

Contents

Source Code


Source Code

subroutine mc_fastion_pass_grid(ind,fields,eb,ptch,denf,output_coords)
    !+ Samples a Guiding Center Fast-ion distribution function at a given [[libfida:pass_grid]] index
    integer, dimension(3), intent(in)      :: ind
        !+ [[libfida:pass_grid]] index
    type(LocalEMFields), intent(out)       :: fields
        !+ Electromagnetic fields at the guiding center
    real(Float64), intent(out)             :: eb
        !+ Energy of the fast ion
    real(Float64), intent(out)             :: ptch
        !+ Pitch of the fast ion
    real(Float64), intent(out)             :: denf
        !+ Fast-ion density at guiding center
    integer, intent(in), optional          :: output_coords
        !+ Indicates coordinate system of `fields`. Beam grid (0), machine (1) and cylindrical (2)

    real(Float64), dimension(fbm%nenergy,fbm%npitch) :: fbeam
    real(Float64), dimension(3) :: rg, rg_cyl
    real(Float64), dimension(3) :: randomu3
    real(Float64) :: rmin, rmax, zmin, phimin
    integer, dimension(2,1) :: ep_ind
    integer :: ocs

    if(present(output_coords)) then
        ocs = output_coords
    else
        ocs = 0
    endif

    denf=0.d0

    call randu(randomu3)
    rmin = pass_grid%r(ind(1))
    rmax = rmin + pass_grid%dr
    zmin = pass_grid%z(ind(2))
    phimin = pass_grid%phi(ind(3))

    ! Sample uniformally in annulus
    rg_cyl(1) = sqrt(randomu3(1)*(rmax**2 - rmin**2) + rmin**2)
    rg_cyl(2) = zmin + randomu3(2)*pass_grid%dz
    rg_cyl(3) = phimin + randomu3(3)*pass_grid%dphi
    call cyl_to_uvw(rg_cyl, rg)

    call get_fields(fields,pos=rg,input_coords=1,output_coords=ocs)
    if(.not.fields%in_plasma) return

    call get_distribution(fbeam,denf,coeffs=fields%b)
    call randind(fbeam,ep_ind)
    call randu(randomu3)
    eb = fbm%energy(ep_ind(1,1)) + fbm%dE*(randomu3(1)-0.5)
    ptch = fbm%pitch(ep_ind(2,1)) + fbm%dp*(randomu3(2)-0.5)

end subroutine mc_fastion_pass_grid