spectrum Subroutine

public subroutine spectrum(vecp, vi, fields, sigma_pi, photons, dlength, lambda, intensity)

Calculates doppler shift, stark splitting, and intensities

Arguments

Type IntentOptional AttributesName
real(kind=Float64), intent(in), dimension(3):: vecp

Vector directing towards optical head

real(kind=Float64), intent(in), dimension(3):: vi

Particle velocity

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

Electro-magnetic fields

real(kind=Float64), intent(in) :: sigma_pi

Sigma-pi ratio

real(kind=Float64), intent(in) :: photons

Photon density from colrad

real(kind=Float64), intent(in) :: dlength

LOS intersection length with beam_grid cell particle is in

real(kind=Float64), intent(out), dimension(n_stark):: lambda

Wavelengths [nm]

real(kind=Float64), intent(out), dimension(n_stark):: intensity

Spectra intensities [Ph/(s cm^2 starkline)]


Called by

proc~~spectrum~~CalledByGraph proc~spectrum spectrum proc~store_photons store_photons proc~store_photons->proc~spectrum proc~store_fw_photons_at_chan store_fw_photons_at_chan proc~store_fw_photons_at_chan->proc~spectrum proc~fida_weights_los fida_weights_los proc~fida_weights_los->proc~store_fw_photons_at_chan proc~dcx_spec dcx_spec proc~dcx_spec->proc~store_photons proc~store_fw_photons store_fw_photons proc~store_fw_photons->proc~store_fw_photons_at_chan proc~halo_spec halo_spec proc~halo_spec->proc~store_photons proc~cold_spec cold_spec proc~cold_spec->proc~store_photons proc~nbi_spec nbi_spec proc~nbi_spec->proc~store_photons proc~store_bes_photons store_bes_photons proc~store_bes_photons->proc~store_photons proc~store_fida_photons store_fida_photons proc~store_fida_photons->proc~store_photons program~fidasim fidasim program~fidasim->proc~fida_weights_los program~fidasim->proc~dcx_spec program~fidasim->proc~halo_spec program~fidasim->proc~cold_spec program~fidasim->proc~nbi_spec

Contents

Source Code


Source Code

subroutine spectrum(vecp, vi, fields, sigma_pi, photons, dlength, lambda, intensity)
    !+ Calculates doppler shift, stark splitting, and intensities
    real(Float64), dimension(3), intent(in)        :: vecp
        !+ Vector directing towards optical head
    real(Float64), dimension(3), intent(in)        :: vi
        !+ Particle velocity
    type(LocalEMFields), intent(in)                :: fields
        !+ Electro-magnetic fields
    real(Float64), intent(in)                      :: sigma_pi
        !+ Sigma-pi ratio
    real(Float64), intent(in)                      :: photons
        !+ Photon density from [[libfida:colrad]]
    real(Float64), intent(in)                      :: dlength
        !+ LOS intersection length with [[libfida:beam_grid]] cell particle is in
    real(Float64), dimension(n_stark), intent(out) :: lambda
        !+ Wavelengths [nm]
    real(Float64), dimension(n_stark), intent(out) :: intensity
        !+ Spectra intensities [Ph/(s cm^2 starkline)]

    real(Float64), dimension(3) :: vp, vn
    real(Float64), dimension(3) :: bfield, efield
    real(Float64) :: E, cos_los_Efield, lambda_shifted
    integer, parameter, dimension(n_stark) :: stark_sign= +1*stark_sigma -1*stark_pi

    !! vector directing towards the optical head
    vp=vecp/norm2(vecp)

    ! Calculate Doppler shift
    vn=vi*0.01d0 ! [m/s]
    lambda_shifted = lambda0*(1.d0 + dot_product(vn,vp)/c0)

    !! Calculate Stark Splitting
    ! Calculate E-field
    bfield = fields%b_norm*fields%b_abs
    efield = fields%e_norm*fields%e_abs
    efield(1) = efield(1) +  vn(2)*bfield(3) - vn(3)*bfield(2)
    efield(2) = efield(2) - (vn(1)*bfield(3) - vn(3)*bfield(1))
    efield(3) = efield(3) +  vn(1)*bfield(2) - vn(2)*bfield(1)
    E = norm2(efield)

    !Stark Splitting
    lambda =  lambda_shifted + E * stark_wavel ![nm]

    !Intensities of stark components
    if (E .eq. 0.d0) then
        cos_los_Efield = 0.d0
    else
        cos_los_Efield = dot_product(vp,efield) / E
    endif

    intensity = stark_intens*(1.d0+ stark_sign* cos_los_Efield**2)
    !! E.g. mirrors may change the pi to sigma intensity ratio
    where (stark_sigma .eq. 1)
        intensity = intensity * sigma_pi
    endwhere

    !! normalize and multiply with photon density from colrad
    intensity = intensity/sum(intensity)*photons*dlength

endsubroutine spectrum