mc_nbi_cell Subroutine

public subroutine mc_nbi_cell(ind, neut_type, vnbi, weight)

Generates a neutral beam velocity vector that passes through cell at ind with weight weight

Arguments

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

Cell index

integer, intent(in) :: neut_type

Neutral Type (1=Full,2=Half,3=Third)

real(kind=Float64), intent(out), dimension(3):: vnbi

Normalized Velocity

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

Weigth/probability of trajectory


Calls

proc~~mc_nbi_cell~~CallsGraph proc~mc_nbi_cell mc_nbi_cell interface~randu randu proc~mc_nbi_cell->interface~randu

Called by

proc~~mc_nbi_cell~~CalledByGraph proc~mc_nbi_cell mc_nbi_cell proc~nbi_spec nbi_spec proc~nbi_spec->proc~mc_nbi_cell program~fidasim fidasim program~fidasim->proc~nbi_spec

Contents

Source Code


Source Code

subroutine mc_nbi_cell(ind, neut_type, vnbi, weight)
    !+ Generates a neutral beam velocity vector
    !+ that passes through cell at `ind` with weight `weight`
    integer, dimension(3), intent(in)        :: ind
        !+ Cell index
    integer, intent(in)                      :: neut_type
        !+ Neutral Type (1=Full,2=Half,3=Third)
    real(Float64), dimension(3), intent(out) :: vnbi
        !+ Normalized Velocity
    real(Float64), intent(out)               :: weight
        !+ Weigth/probability of trajectory

    real(Float64), dimension(3) :: rc         !! Center of cell in uvw coords
    real(Float64), dimension(3) :: uvw_rf     !! End position in xyz coords
    real(Float64), dimension(3) :: xyz_rf     !! End position in xyz coords
    real(Float64), dimension(3) :: uvw_src    !! Start position on ion source
    real(Float64), dimension(3) :: xyz_src    !! Start position on ion source
    real(Float64), dimension(3) :: uvw_ray    !! NBI velocity in uvw coords
    real(Float64), dimension(3) :: xyz_ray    !! NBI velocity in xyz coords
    real(Float64), dimension(3) :: xyz_ape    !! Aperture plane intersection point
    real(Float64), dimension(3) :: randomu    !! uniform random numbers
    real(Float64) :: sqrt_rho, theta, vy, vz, theta_y, theta_z, py, pz
    integer :: i, j
    logical :: valid_trajectory

    rc = [beam_grid%xc(ind(1)), beam_grid%yc(ind(2)), beam_grid%zc(ind(3))]
    valid_trajectory = .False.
    rejection_loop: do i=1,1000
        call randu(randomu)
        select case (nbi%shape)
            case (1)
                ! Uniformally sample in rectangle
                xyz_src(1) =  0.d0
                xyz_src(2) =  nbi%widy * 2.d0*(randomu(1)-0.5d0)
                xyz_src(3) =  nbi%widz * 2.d0*(randomu(2)-0.5d0)
            case (2)
                ! Uniformally sample in ellipse
                sqrt_rho = sqrt(randomu(1))
                theta = 2*pi*randomu(2)
                xyz_src(1) = 0.d0
                xyz_src(2) = nbi%widy*sqrt_rho*cos(theta)
                xyz_src(3) = nbi%widz*sqrt_rho*sin(theta)
        end select

        !! Create random position in the cell
        call randu(randomu)
        uvw_rf = rc + (randomu - 0.5)*beam_grid%dr
        xyz_rf = matmul(nbi%inv_basis, uvw_rf - nbi%src)

        xyz_ray = xyz_rf - xyz_src
        xyz_ray = xyz_ray/norm2(xyz_ray)

        aperture_loop: do j=1,nbi%naperture
            xyz_ape = xyz_ray*nbi%adist(j) + xyz_src
            select case (nbi%ashape(j))
                case (1)
                    if ((abs(xyz_ape(2) - nbi%aoffy(j)).gt.nbi%awidy(j)).or.&
                        (abs(xyz_ape(3) - nbi%aoffz(j)).gt.nbi%awidz(j))) then
                        cycle rejection_loop
                    endif
                case (2)
                    if ((((xyz_ape(2) - nbi%aoffy(j))*nbi%awidz(j))**2 + &
                         ((xyz_ape(3) - nbi%aoffz(j))*nbi%awidy(j))**2).gt. &
                         (nbi%awidy(j)*nbi%awidz(j))**2) then
                        cycle rejection_loop
                    endif
            end select
        enddo aperture_loop
        valid_trajectory = .True.

        !! Convert to beam centerline coordinates to beam grid coordinates
        uvw_src = matmul(nbi%basis,xyz_src) + nbi%src
        uvw_ray = matmul(nbi%basis,xyz_ray)
        vnbi = nbi%vinj*uvw_ray/norm2(uvw_ray)/sqrt(real(neut_type))

        exit rejection_loop
    enddo rejection_loop

    !Set Default trajectory in case rejection sampling fails
    if(.not.valid_trajectory)then
        call randu(randomu)
        uvw_rf = rc + (randomu - 0.5)*beam_grid%dr
        uvw_ray = uvw_rf - nbi%src
        vnbi = nbi%vinj*uvw_ray/norm2(uvw_ray)/sqrt(real(neut_type))
    endif

    !! Find probability of trajectory
    vy = xyz_ray(2)/xyz_ray(1)
    vz = xyz_ray(3)/xyz_ray(1)
    theta_y = atan(vy + xyz_src(2)/nbi%focy)
    theta_z = atan(vz + xyz_src(3)/nbi%focz)

    py = (1.0/(1.0 + (vy + xyz_src(2)/nbi%focy)**2)) * &
         exp(-(theta_y**2)/(2*nbi%divy(neut_type)**2)) / &
         sqrt(2*nbi%divy(neut_type)**2)

    pz = (1.0/(1.0 + (vz + xyz_src(3)/nbi%focy)**2)) * &
         exp(-(theta_z**2)/(2*nbi%divz(neut_type)**2)) / &
         sqrt(2*nbi%divz(neut_type)**2)

    weight = py*pz

end subroutine mc_nbi_cell