2021-12-19 16:39:19 +01:00
! This modules contains the core GRAY routines
2021-12-15 02:31:14 +01:00
module gray_core
2021-12-19 16:39:19 +01:00
2015-11-18 17:34:33 +01:00
use const_and_precisions , only : wp_
2021-12-19 16:39:19 +01:00
2015-11-18 17:34:33 +01:00
implicit none
contains
2024-08-14 10:47:39 +02:00
subroutine gray_main ( params , data , plasma , results , error , rhout )
2024-05-02 00:47:59 +02:00
use const_and_precisions , only : zero , one , comp_tiny
2024-03-12 16:42:19 +01:00
use polarization , only : ellipse_to_field
2024-05-02 00:47:59 +02:00
use types , only : table , wrap
use gray_params , only : gray_parameters , gray_data , gray_results , EQ_VACUUM
2024-08-14 10:47:39 +02:00
use gray_plasma , only : abstract_plasma
2024-05-02 00:47:59 +02:00
use gray_tables , only : init_tables , store_ec_profiles , store_ray_data , &
store_beam_shape , find_flux_surfaces , &
kinetic_profiles , ec_resonance , inputs_maps
use gray_errors , only : is_critical , print_err_raytracing , print_err_ecrh_cd
2021-12-15 02:31:09 +01:00
use beams , only : xgygcoeff , launchangles2n
2024-07-07 13:18:55 +02:00
use beamdata , only : pweight
2024-05-02 00:47:59 +02:00
use magsurf_data , only : compute_flux_averages , dealloc_surfvec
2021-12-15 02:31:09 +01:00
use pec , only : pec_init , spec , postproc_profiles , dealloc_pec , &
rhop_tab , rhot_tab
2023-10-04 17:00:45 +02:00
use utils , only : vmaxmin , inside
2024-04-23 17:00:40 +02:00
use multipass , only : initbeam , initmultipass , turnoffray , &
plasma_in , plasma_out , wall_out
2021-12-18 18:57:38 +01:00
use logger , only : log_info , log_debug
2019-03-26 15:21:22 +01:00
2021-12-19 16:39:19 +01:00
! subroutine arguments
2024-08-14 10:47:39 +02:00
type ( gray_parameters ) , intent ( inout ) :: params
type ( gray_data ) , intent ( in ) :: data
class ( abstract_plasma ) , intent ( in ) :: plasma
type ( gray_results ) , intent ( out ) :: results
2021-12-15 02:31:09 +01:00
! Predefined grid for the output profiles (optional)
2015-11-24 17:36:20 +01:00
real ( wp_ ) , dimension ( : ) , intent ( in ) , optional :: rhout
2015-11-18 17:34:33 +01:00
2021-12-15 02:31:09 +01:00
! Exit code
integer , intent ( out ) :: error
! local variables
2019-03-26 15:21:22 +01:00
real ( wp_ ) , parameter :: taucr = 1 2._wp_ , etaucr = exp ( - taucr )
2022-05-10 12:36:37 +02:00
character , dimension ( 2 ) , parameter :: mode = [ 'O' , 'X' ]
2021-12-18 18:57:38 +01:00
2022-05-20 13:10:49 +02:00
integer :: sox
real ( wp_ ) :: ak0 , bres , xgcn , xg , yg , rrm , zzm , alpha , didp , anpl , anpr , anprim , anprre
2019-03-26 15:21:22 +01:00
real ( wp_ ) :: chipol , psipol , btot , psinv , dens , tekev , dersdst , derdnm
2015-11-19 19:20:58 +01:00
real ( wp_ ) :: tau , pow , dids , ddr , ddi , taumn , taumx
2015-11-23 18:55:27 +01:00
real ( wp_ ) :: rhotpav , drhotpav , rhotjava , drhotjava , dpdvp , jphip
real ( wp_ ) :: rhotp , drhotp , rhotj , drhotj , dpdvmx , jphimx , ratjamx , ratjbmx
2019-03-26 15:21:22 +01:00
real ( wp_ ) :: pabs_beam , icd_beam , cpl_beam1 , cpl_beam2 , cpl_cbeam1 , cpl_cbeam2
2015-11-23 18:55:27 +01:00
2024-07-07 13:18:55 +02:00
integer :: iox , nharm , nhf , iokhawa , ierrn , ierrhcd , index_rt , parent_index_rt
fix coupling for subsequent beams
In situations when multiple beams are traced, either when allowing
multiple plasma crossings (raytracing.ipass > 0) or the initial polarisation
is mixed (raytracing.ipol == .true.), the couplings of all but the first
beam (with least index_rt) were invalid.
The bug is due to the re-use of the psipol,chipol variables as the beams
are traced sequentially over the beam_loop. For the first beam being
traced the psipol,chipol are correctly initialised to the user-defined
value and the resulting coupling is correct.
However, in each subsequent beam the values were not set to those of the
parent beam (or to the user-defined value in the case of the first X
mode beam), but to those of the previous beams (current index_rt - 1).
This change repurposes the psipv,chipv arrays to store the polarisation
of the parent beams, including the initial user-defined value and makes
plasma_in always use these to compute the coupling.
In addition, in the case the polarisation is not immediately known (i.e.
if raytracing.ipol == .false.), this change postpones the computation of
the Jones vector (ext, eyt) from the launch point, if the magnetic
equilibrium is available, to when the ray actually crosses the
plasma boundary.
The original code, besides being strictly incorrect, can lead to
non-negligible alterations to the coupling. This change also mean:
1. most of the functionality of `set_pol` has been merged with
`plasma_in`
2. the polarisation is undefined and the Jones vector is set to the
placeholder value [1, 0] till `plasma_im` is called
Finally, `polarcold` is removed because it's unused.
2024-03-02 17:32:03 +01:00
integer :: ip , ib , iopmin , ipar , child_index_rt
2024-07-30 10:57:07 +02:00
integer :: igrad_b , istop_pass , nbeam_pass
2019-03-26 15:21:22 +01:00
logical :: ins_pl , ins_wl , ent_pl , ext_pl , ent_wl , ext_wl , iboff
2024-04-23 17:00:40 +02:00
! i: integration step, jk: global ray index
integer :: i , jk
2015-11-18 17:34:33 +01:00
2021-12-18 18:57:38 +01:00
! buffer for formatting log messages
character ( 256 ) :: msg
2016-04-27 16:37:57 +02:00
2024-04-23 17:00:40 +02:00
real ( wp_ ) , dimension ( 2 ) :: pabs_pass , icd_pass , cpl
real ( wp_ ) , dimension ( 3 ) :: xv , anv0 , anv , bv , derxg
2024-05-02 00:47:59 +02:00
associate ( nray = > params % raytracing % nray , &
nrayr = > params % raytracing % nrayr , &
nrayth = > params % raytracing % nrayth , &
nstep = > params % raytracing % nstep , &
2024-07-07 13:18:55 +02:00
npass = > params % raytracing % ipass , &
2024-05-02 00:47:59 +02:00
nbeam_tot = > 2 ** ( params % raytracing % ipass + 1 ) - 2 , &
nbeam_max = > 2 ** ( params % raytracing % ipass ) )
2024-04-23 17:00:40 +02:00
block
! ray variables
real ( wp_ ) , dimension ( 6 , nray ) :: yw , ypw
real ( wp_ ) , dimension ( 3 , nray ) :: gri
real ( wp_ ) , dimension ( 3 , 3 , nray ) :: ggri
real ( wp_ ) , dimension ( 3 , nrayth , nrayr ) :: xc , du1
real ( wp_ ) , dimension ( nray ) :: ccci0 , p0jk
real ( wp_ ) , dimension ( nray ) :: tau0 , alphaabs0
real ( wp_ ) , dimension ( nray ) :: dids0
integer , dimension ( nray ) :: iiv
real ( wp_ ) , dimension ( nray , nstep ) :: psjki , ppabs , ccci
complex ( wp_ ) , dimension ( nray ) :: ext , eyt
! multipass variables
logical , dimension ( nray ) :: iwait
integer , dimension ( nray ) :: iow , iop
logical , dimension ( nray , nbeam_tot ) :: iroff
real ( wp_ ) , dimension ( 6 , nray , nbeam_max - 2 ) :: yynext , yypnext
real ( wp_ ) , dimension ( 6 , nray ) :: yw0 , ypw0
real ( wp_ ) , dimension ( nray , nbeam_tot ) :: stnext
real ( wp_ ) , dimension ( nray ) :: stv , p0ray
real ( wp_ ) , dimension ( nray , nbeam_tot ) :: taus , cpls
real ( wp_ ) , dimension ( nray ) :: tau1 , etau1 , cpl1 , lgcpl1
real ( wp_ ) , dimension ( 0 : nbeam_tot ) :: psipv , chipv
! beam variables
real ( wp_ ) , dimension ( params % output % nrho ) :: jphi_beam , pins_beam
real ( wp_ ) , dimension ( params % output % nrho ) :: currins_beam , dpdv_beam , jcd_beam
2021-12-15 02:31:09 +01:00
! ======== set environment BEGIN ========
! Compute X=ω/ω_ce and Y=(ω/ω_pe)² (with B=1)
call xgygcoeff ( params % antenna % fghz , ak0 , bres , xgcn )
2015-11-18 17:34:33 +01:00
2024-05-02 00:47:59 +02:00
! Initialise the output tables
call init_tables ( params , results % tables )
2021-12-15 02:31:09 +01:00
! Compute the initial cartesian wavevector (anv0)
2023-03-26 16:03:57 +02:00
! from launch angles α ,β and the position
2021-12-15 02:31:09 +01:00
call launchangles2n ( params % antenna , anv0 )
2015-11-18 17:34:33 +01:00
2024-01-30 10:14:24 +01:00
if ( params % equilibrium % iequil / = EQ_VACUUM ) then
! Initialise the magsurf_data module
2024-07-30 10:57:07 +02:00
call compute_flux_averages ( params , results % tables )
2022-05-10 12:36:37 +02:00
2024-01-30 10:14:24 +01:00
! Initialise the output profiles
2024-07-07 13:18:55 +02:00
call pec_init ( params % output , rhout )
2024-01-30 10:14:24 +01:00
end if
2021-12-15 02:31:09 +01:00
! Allocate memory for the results...
allocate ( results % dpdv ( params % output % nrho ) )
allocate ( results % jcd ( params % output % nrho ) )
! ...and initialise them
results % pabs = zero
results % icd = zero
results % dpdv = zero
results % jcd = zero
! ========= set environment END =========
2024-05-02 00:47:59 +02:00
! Pre-determinted tables
2024-08-14 10:47:39 +02:00
results % tables % kinetic_profiles = kinetic_profiles ( params , plasma )
2024-05-02 00:47:59 +02:00
results % tables % ec_resonance = ec_resonance ( params , bres )
2024-08-14 10:47:39 +02:00
results % tables % inputs_maps = inputs_maps ( params , plasma , bres , xgcn )
2021-12-15 02:31:09 +01:00
2024-05-02 00:47:59 +02:00
! print ψ surface for q=3/2 and q=2/1
2024-07-07 13:18:55 +02:00
call find_flux_surfaces ( &
2024-07-30 10:57:07 +02:00
qvals = [ 1.5_wp_ , 2.0_wp_ ] , params = params , &
2024-07-07 13:18:55 +02:00
tbl = results % tables % flux_surfaces )
2021-12-15 02:31:09 +01:00
! print initial position
2021-12-18 18:57:38 +01:00
write ( msg , '("initial position:",3(x,g0.3))' ) params % antenna % pos
call log_info ( msg , mod = 'gray_core' , proc = 'gray_main' )
write ( msg , '("initial direction:",2(x,a,"=",g0.2))' ) &
'α ' , params % antenna % alpha , 'β' , params % antenna % beta
call log_info ( msg , mod = 'gray_core' , proc = 'gray_main' )
2021-12-15 02:31:09 +01:00
! =========== main loop BEGIN ===========
2024-07-07 13:18:55 +02:00
call initmultipass ( params , iroff , yynext , yypnext , yw0 , ypw0 , &
stnext , p0ray , taus , tau1 , etau1 , cpls , &
cpl1 , lgcpl1 , psipv , chipv )
2022-05-10 12:36:37 +02:00
2022-05-20 13:10:49 +02:00
sox = 1 ! mode inverted for each beam
2019-03-26 15:21:22 +01:00
iox = 2 ! start with O: sox=-1, iox=1
2022-05-10 12:36:37 +02:00
2024-07-07 13:18:55 +02:00
call pweight ( params % raytracing , params % antenna % power , p0jk )
2015-11-18 17:34:33 +01:00
fix coupling for subsequent beams
In situations when multiple beams are traced, either when allowing
multiple plasma crossings (raytracing.ipass > 0) or the initial polarisation
is mixed (raytracing.ipol == .true.), the couplings of all but the first
beam (with least index_rt) were invalid.
The bug is due to the re-use of the psipol,chipol variables as the beams
are traced sequentially over the beam_loop. For the first beam being
traced the psipol,chipol are correctly initialised to the user-defined
value and the resulting coupling is correct.
However, in each subsequent beam the values were not set to those of the
parent beam (or to the user-defined value in the case of the first X
mode beam), but to those of the previous beams (current index_rt - 1).
This change repurposes the psipv,chipv arrays to store the polarisation
of the parent beams, including the initial user-defined value and makes
plasma_in always use these to compute the coupling.
In addition, in the case the polarisation is not immediately known (i.e.
if raytracing.ipol == .false.), this change postpones the computation of
the Jones vector (ext, eyt) from the launch point, if the magnetic
equilibrium is available, to when the ray actually crosses the
plasma boundary.
The original code, besides being strictly incorrect, can lead to
non-negligible alterations to the coupling. This change also mean:
1. most of the functionality of `set_pol` has been merged with
`plasma_in`
2. the polarisation is undefined and the Jones vector is set to the
placeholder value [1, 0] till `plasma_im` is called
Finally, `polarcold` is removed because it's unused.
2024-03-02 17:32:03 +01:00
! Set original polarisation
psipv ( 0 ) = params % antenna % psi
chipv ( 0 ) = params % antenna % chi
2019-03-26 15:21:22 +01:00
nbeam_pass = 1 ! max n of beam per pass
index_rt = 0 ! global beam index: 1,O 2,X 1st pass
2019-03-28 10:50:28 +01:00
! | | | |
2021-12-18 18:57:38 +01:00
call log_debug ( 'pass loop start' , mod = 'gray_core' , proc = 'gray_main' ) ! 3,O 4,X 5,O 6,X 2nd pass
2022-05-10 12:36:37 +02:00
main_loop : do ip = 1 , params % raytracing % ipass
2021-12-18 18:57:38 +01:00
write ( msg , '("pass: ",g0)' ) ip
call log_info ( msg , mod = 'gray_core' , proc = 'gray_main' )
2019-03-26 15:21:22 +01:00
pabs_pass = zero
icd_pass = zero
istop_pass = 0 ! stop flag for current pass
nbeam_pass = 2 * nbeam_pass ! max n of beams in current pass
2022-05-10 12:36:37 +02:00
if ( ip > 1 ) then
2019-03-28 10:50:28 +01:00
du1 = zero
2019-03-26 15:21:22 +01:00
gri = zero
ggri = zero
2022-05-10 12:36:37 +02:00
if ( ip == params % raytracing % ipass ) cpl = [ zero , zero ] ! no successive passes
2019-03-26 15:21:22 +01:00
end if
2022-05-10 12:36:37 +02:00
! =========== beam loop BEGIN ===========
2021-12-18 18:57:38 +01:00
call log_debug ( 'beam loop start' , mod = 'gray_core' , proc = 'gray_main' )
2022-05-10 12:36:37 +02:00
beam_loop : do ib = 1 , nbeam_pass
2019-03-26 15:21:22 +01:00
sox = - sox ! invert mode
iox = 3 - iox ! O-mode at ip=1,ib=1
index_rt = index_rt + 1
fix coupling for subsequent beams
In situations when multiple beams are traced, either when allowing
multiple plasma crossings (raytracing.ipass > 0) or the initial polarisation
is mixed (raytracing.ipol == .true.), the couplings of all but the first
beam (with least index_rt) were invalid.
The bug is due to the re-use of the psipol,chipol variables as the beams
are traced sequentially over the beam_loop. For the first beam being
traced the psipol,chipol are correctly initialised to the user-defined
value and the resulting coupling is correct.
However, in each subsequent beam the values were not set to those of the
parent beam (or to the user-defined value in the case of the first X
mode beam), but to those of the previous beams (current index_rt - 1).
This change repurposes the psipv,chipv arrays to store the polarisation
of the parent beams, including the initial user-defined value and makes
plasma_in always use these to compute the coupling.
In addition, in the case the polarisation is not immediately known (i.e.
if raytracing.ipol == .false.), this change postpones the computation of
the Jones vector (ext, eyt) from the launch point, if the magnetic
equilibrium is available, to when the ray actually crosses the
plasma boundary.
The original code, besides being strictly incorrect, can lead to
non-negligible alterations to the coupling. This change also mean:
1. most of the functionality of `set_pol` has been merged with
`plasma_in`
2. the polarisation is undefined and the Jones vector is set to the
placeholder value [1, 0] till `plasma_im` is called
Finally, `polarcold` is removed because it's unused.
2024-03-02 17:32:03 +01:00
child_index_rt = 2 * index_rt + 1 ! * index_rt of O-mode child beam
parent_index_rt = ceiling ( index_rt / 2.0_wp_ ) - 1 ! * index_rt of parent beam
2015-11-18 17:34:33 +01:00
2019-03-26 15:21:22 +01:00
call initbeam ( index_rt , iroff , iboff , iwait , stv , jphi_beam , &
pins_beam , currins_beam , dpdv_beam , jcd_beam )
2021-12-18 18:57:38 +01:00
write ( msg , '(" beam: ",g0," (",a1," mode)")' ) index_rt , mode ( iox )
call log_info ( msg , mod = 'gray_core' , proc = 'gray_main' )
2019-03-26 15:21:22 +01:00
if ( iboff ) then ! no propagation for current beam
istop_pass = istop_pass + 1 ! * +1 non propagating beam
2021-12-18 18:57:38 +01:00
call log_info ( " beam is off" , mod = 'gray_core' , proc = 'gray_main' )
2019-03-26 15:21:22 +01:00
cycle
2015-11-18 17:34:33 +01:00
end if
2022-05-10 12:36:37 +02:00
2019-03-26 15:21:22 +01:00
call vectinit ( psjki , ppabs , ccci , tau0 , alphaabs0 , dids0 , ccci0 , iiv )
2022-05-10 12:36:37 +02:00
if ( ip == 1 ) then ! 1st pass
igrad_b = params % raytracing % igrad ! * input value, igrad_b=0 from 2nd pass
2019-03-28 10:50:28 +01:00
tau1 = zero ! * tau from previous passes
2019-03-26 15:21:22 +01:00
etau1 = one
2019-03-28 10:50:28 +01:00
cpl1 = one ! * coupling from previous passes
2019-03-26 15:21:22 +01:00
lgcpl1 = zero
p0ray = p0jk ! * initial beam power
2024-05-02 00:47:59 +02:00
call ic_gb ( params , anv0 , ak0 , yw , ypw , stv , xc , du1 , &
gri , ggri , index_rt , results % tables ) ! * initial conditions
2022-05-10 12:36:37 +02:00
do jk = 1 , params % raytracing % nray
2019-03-26 15:21:22 +01:00
zzm = yw ( 3 , jk ) * 0.01_wp_
rrm = sqrt ( yw ( 1 , jk ) * yw ( 1 , jk ) + yw ( 2 , jk ) * yw ( 2 , jk ) ) * 0.01_wp_
2022-05-10 12:36:37 +02:00
2024-07-30 10:57:07 +02:00
if ( data % equilibrium % limiter % contains ( rrm , zzm ) ) then ! * start propagation in/outside vessel?
2019-03-26 15:21:22 +01:00
iow ( jk ) = 1 ! + inside
else
iow ( jk ) = 0 ! + outside
end if
end do
2022-05-10 12:36:37 +02:00
2019-03-28 10:50:28 +01:00
else ! 2nd+ passes
2019-03-26 15:21:22 +01:00
ipar = ( index_rt + 1 ) / 2 - 1 ! * parent beam index
yw = yynext ( : , : , ipar ) ! * starting coordinates from
ypw = yypnext ( : , : , ipar ) ! parent beam last step
stv = stnext ( : , ipar ) ! * starting step from parent beam last step
iow = 1 ! * start propagation inside vessel
tau1 = taus ( : , index_rt ) ! * tau from previous passes
etau1 = exp ( - tau1 )
cpl1 = cpls ( : , index_rt ) ! * coupling from previous passes
lgcpl1 = - log ( cpl1 )
p0ray = p0jk * etau1 * cpl1 ! * initial beam power
end if
iop = 0 ! start propagation outside plasma
2022-05-10 12:36:37 +02:00
if ( params % raytracing % nray > 1 . and . all ( . not . iwait ) ) & ! iproj=0 ==> nfilp=8
2024-05-02 00:47:59 +02:00
call store_beam_shape ( params % raytracing , results % tables , stv , yw )
2022-05-10 12:36:37 +02:00
! ======= propagation loop BEGIN =======
2021-12-18 18:57:38 +01:00
call log_debug ( ' propagation loop start' , mod = 'gray_core' , proc = 'gray_main' )
2022-05-10 12:36:37 +02:00
propagation_loop : do i = 1 , params % raytracing % nstep
! advance one step with "frozen" grad(S_I)
do jk = 1 , params % raytracing % nray
2019-03-26 15:21:22 +01:00
if ( iwait ( jk ) ) cycle ! jk ray is waiting for next pass
2022-05-10 12:36:37 +02:00
stv ( jk ) = stv ( jk ) + params % raytracing % dst ! current ray step
2024-08-14 10:47:39 +02:00
call rkstep ( params , plasma , sox , bres , xgcn , yw ( : , jk ) , &
ypw ( : , jk ) , gri ( : , jk ) , ggri ( : , : , jk ) , igrad_b )
2019-03-26 15:21:22 +01:00
end do
2022-05-10 12:36:37 +02:00
! update position and grad
2024-07-07 13:18:55 +02:00
if ( igrad_b == 1 ) call gradi_upd ( params % raytracing , yw , ak0 , xc , du1 , gri , ggri )
2022-05-10 12:36:37 +02:00
2021-12-15 02:31:09 +01:00
error = 0
2019-03-26 15:21:22 +01:00
iopmin = 10
2022-05-10 12:36:37 +02:00
! =========== rays loop BEGIN ===========
rays_loop : do jk = 1 , params % raytracing % nray
2019-03-26 15:21:22 +01:00
if ( iwait ( jk ) ) cycle ! jk ray is waiting for next pass
2022-05-10 12:36:37 +02:00
! compute derivatives with updated gradient and local plasma values
2019-03-26 15:21:22 +01:00
xv = yw ( 1 : 3 , jk )
anv = yw ( 4 : 6 , jk )
2024-08-14 10:47:39 +02:00
call ywppla_upd ( params , plasma , xv , anv , gri ( : , jk ) , ggri ( : , : , jk ) , &
sox , bres , xgcn , ypw ( : , jk ) , psinv , dens , btot , bv , &
xg , yg , derxg , anpl , anpr , ddr , ddi , dersdst , &
derdnm , ierrn , igrad_b )
2022-05-10 12:36:37 +02:00
! update global error code and print message
2019-03-26 15:21:22 +01:00
if ( ierrn / = 0 ) then
2021-12-15 02:31:09 +01:00
error = ior ( error , ierrn )
2022-07-14 00:38:34 +02:00
call print_err_raytracing ( ierrn , i , anpl )
2019-03-26 15:21:22 +01:00
end if
2022-05-10 12:36:37 +02:00
! check entrance/exit plasma/wall
2019-03-26 15:21:22 +01:00
zzm = xv ( 3 ) * 0.01_wp_
rrm = sqrt ( xv ( 1 ) * xv ( 1 ) + xv ( 2 ) * xv ( 2 ) ) * 0.01_wp_
2022-05-10 12:36:37 +02:00
ins_pl = ( psinv > = zero . and . psinv < params % profiles % psnbnd ) ! in/out plasma?
2024-07-30 10:57:07 +02:00
ins_wl = data % equilibrium % limiter % contains ( rrm , zzm ) ! in/out vessel?
2022-05-10 12:36:37 +02:00
ent_pl = ( mod ( iop ( jk ) , 2 ) == 0 . and . ins_pl ) ! enter plasma
ext_pl = ( mod ( iop ( jk ) , 2 ) == 1 . and . . not . ins_pl ) ! exit plasma
ent_wl = ( mod ( iow ( jk ) , 2 ) == 0 . and . ins_wl ) ! enter vessel
ext_wl = ( mod ( iow ( jk ) , 2 ) == 1 . and . . not . ins_wl ) ! exit vessel
2019-03-26 15:21:22 +01:00
if ( ent_pl ) then ! ray enters plasma
2022-05-26 02:33:55 +02:00
write ( msg , '(" ray ",g0," entered plasma (",g0," steps)")' ) jk , i
call log_debug ( msg , mod = 'gray_core' , proc = 'gray_main' )
2024-03-12 16:42:19 +01:00
call ellipse_to_field ( psipv ( parent_index_rt ) , chipv ( parent_index_rt ) , & ! compute polarisation and couplings
ext , eyt )
fix coupling for subsequent beams
In situations when multiple beams are traced, either when allowing
multiple plasma crossings (raytracing.ipass > 0) or the initial polarisation
is mixed (raytracing.ipol == .true.), the couplings of all but the first
beam (with least index_rt) were invalid.
The bug is due to the re-use of the psipol,chipol variables as the beams
are traced sequentially over the beam_loop. For the first beam being
traced the psipol,chipol are correctly initialised to the user-defined
value and the resulting coupling is correct.
However, in each subsequent beam the values were not set to those of the
parent beam (or to the user-defined value in the case of the first X
mode beam), but to those of the previous beams (current index_rt - 1).
This change repurposes the psipv,chipv arrays to store the polarisation
of the parent beams, including the initial user-defined value and makes
plasma_in always use these to compute the coupling.
In addition, in the case the polarisation is not immediately known (i.e.
if raytracing.ipol == .false.), this change postpones the computation of
the Jones vector (ext, eyt) from the launch point, if the magnetic
equilibrium is available, to when the ray actually crosses the
plasma boundary.
The original code, besides being strictly incorrect, can lead to
non-negligible alterations to the coupling. This change also mean:
1. most of the functionality of `set_pol` has been merged with
`plasma_in`
2. the polarisation is undefined and the Jones vector is set to the
placeholder value [1, 0] till `plasma_im` is called
Finally, `polarcold` is removed because it's unused.
2024-03-02 17:32:03 +01:00
call plasma_in ( jk , xv , anv , bres , sox , cpl , psipol , chipol , iop , ext , eyt , &
perfect = . not . params % raytracing % ipol &
. and . params % antenna % iox == iox &
. and . iop ( jk ) == 0 . and . ip == 1 )
2019-03-26 15:21:22 +01:00
2022-05-10 12:36:37 +02:00
if ( iop ( jk ) == 1 . and . ip == 1 ) then ! * 1st entrance on 1st pass (ray hasn't entered in plasma yet) => continue current pass
fix coupling for subsequent beams
In situations when multiple beams are traced, either when allowing
multiple plasma crossings (raytracing.ipass > 0) or the initial polarisation
is mixed (raytracing.ipol == .true.), the couplings of all but the first
beam (with least index_rt) were invalid.
The bug is due to the re-use of the psipol,chipol variables as the beams
are traced sequentially over the beam_loop. For the first beam being
traced the psipol,chipol are correctly initialised to the user-defined
value and the resulting coupling is correct.
However, in each subsequent beam the values were not set to those of the
parent beam (or to the user-defined value in the case of the first X
mode beam), but to those of the previous beams (current index_rt - 1).
This change repurposes the psipv,chipv arrays to store the polarisation
of the parent beams, including the initial user-defined value and makes
plasma_in always use these to compute the coupling.
In addition, in the case the polarisation is not immediately known (i.e.
if raytracing.ipol == .false.), this change postpones the computation of
the Jones vector (ext, eyt) from the launch point, if the magnetic
equilibrium is available, to when the ray actually crosses the
plasma boundary.
The original code, besides being strictly incorrect, can lead to
non-negligible alterations to the coupling. This change also mean:
1. most of the functionality of `set_pol` has been merged with
`plasma_in`
2. the polarisation is undefined and the Jones vector is set to the
placeholder value [1, 0] till `plasma_im` is called
Finally, `polarcold` is removed because it's unused.
2024-03-02 17:32:03 +01:00
if ( cpl ( iox ) < etaucr ) then ! + IF low coupled power for current mode => de-activate derived rays
2024-07-07 13:18:55 +02:00
call turnoffray ( jk , ip + 1 , npass , 2 * ib + 2 - iox , iroff )
2019-03-26 15:21:22 +01:00
iwait ( jk ) = . true . ! . stop advancement and H&CD computation for current ray
if ( cpl ( iox ) . le . comp_tiny ) cpl ( iox ) = etaucr
else ! + ELSE assign coupled power to current ray
p0ray ( jk ) = p0ray ( jk ) * cpl ( iox )
end if
cpls ( jk , index_rt ) = cpl ( iox )
2022-05-10 12:36:37 +02:00
if ( jk == 1 ) then
2021-12-18 18:57:38 +01:00
write ( msg , '(" 1st pass - central ray (",a1,"-mode) c=",g0.4)' ) &
mode ( iox ) , cpl ( iox )
call log_info ( msg , mod = 'gray_core' , proc = 'gray_main' )
fix coupling for subsequent beams
In situations when multiple beams are traced, either when allowing
multiple plasma crossings (raytracing.ipass > 0) or the initial polarisation
is mixed (raytracing.ipol == .true.), the couplings of all but the first
beam (with least index_rt) were invalid.
The bug is due to the re-use of the psipol,chipol variables as the beams
are traced sequentially over the beam_loop. For the first beam being
traced the psipol,chipol are correctly initialised to the user-defined
value and the resulting coupling is correct.
However, in each subsequent beam the values were not set to those of the
parent beam (or to the user-defined value in the case of the first X
mode beam), but to those of the previous beams (current index_rt - 1).
This change repurposes the psipv,chipv arrays to store the polarisation
of the parent beams, including the initial user-defined value and makes
plasma_in always use these to compute the coupling.
In addition, in the case the polarisation is not immediately known (i.e.
if raytracing.ipol == .false.), this change postpones the computation of
the Jones vector (ext, eyt) from the launch point, if the magnetic
equilibrium is available, to when the ray actually crosses the
plasma boundary.
The original code, besides being strictly incorrect, can lead to
non-negligible alterations to the coupling. This change also mean:
1. most of the functionality of `set_pol` has been merged with
`plasma_in`
2. the polarisation is undefined and the Jones vector is set to the
placeholder value [1, 0] till `plasma_im` is called
Finally, `polarcold` is removed because it's unused.
2024-03-02 17:32:03 +01:00
write ( msg , '(" polarisation: ψ=",g0.5,"°, χ=",g0.5,"°")' ) &
psipol , chipol
call log_debug ( msg , mod = 'gray_core' , proc = 'gray_main' )
2019-03-26 15:21:22 +01:00
psipv ( index_rt ) = psipol ! + polarization angles at plasma boundary for central ray
chipv ( index_rt ) = chipol
end if
2022-05-10 12:36:37 +02:00
else if ( iop ( jk ) > 2 ) then ! * 2nd entrance on 1st pass / entrance on 2nd+ pass => end of current pass for ray jk
2019-03-26 15:21:22 +01:00
igrad_b = 0 ! + switch to ray-tracing
iwait ( jk ) = . true . ! + stop advancement and H&CD computation for current ray
2022-05-10 12:36:37 +02:00
if ( ip < params % raytracing % ipass ) then ! + not last pass
2019-03-28 10:50:28 +01:00
yynext ( : , jk , index_rt ) = yw0 ( : , jk ) ! . copy starting coordinates
yypnext ( : , jk , index_rt ) = ypw0 ( : , jk ) ! for next pass from last step
2022-05-10 12:36:37 +02:00
stnext ( jk , index_rt ) = stv ( jk ) - params % raytracing % dst ! . starting step for next pass = last step
if ( cpl ( 1 ) < etaucr ) then ! . low coupled power for O-mode => de-activate derived rays
2024-07-07 13:18:55 +02:00
call turnoffray ( jk , ip + 1 , npass , 2 * ib - 1 , iroff )
2019-03-26 15:21:22 +01:00
if ( cpl ( 1 ) . le . comp_tiny ) cpl ( 1 ) = etaucr
end if
2022-05-10 12:36:37 +02:00
if ( cpl ( 2 ) < etaucr ) then ! . low coupled power for X-mode => de-activate derived rays
2024-07-07 13:18:55 +02:00
call turnoffray ( jk , ip + 1 , npass , 2 * ib , iroff )
2019-03-26 15:21:22 +01:00
if ( cpl ( 2 ) . le . comp_tiny ) cpl ( 2 ) = etaucr
end if
2022-05-10 12:36:37 +02:00
fix coupling for subsequent beams
In situations when multiple beams are traced, either when allowing
multiple plasma crossings (raytracing.ipass > 0) or the initial polarisation
is mixed (raytracing.ipol == .true.), the couplings of all but the first
beam (with least index_rt) were invalid.
The bug is due to the re-use of the psipol,chipol variables as the beams
are traced sequentially over the beam_loop. For the first beam being
traced the psipol,chipol are correctly initialised to the user-defined
value and the resulting coupling is correct.
However, in each subsequent beam the values were not set to those of the
parent beam (or to the user-defined value in the case of the first X
mode beam), but to those of the previous beams (current index_rt - 1).
This change repurposes the psipv,chipv arrays to store the polarisation
of the parent beams, including the initial user-defined value and makes
plasma_in always use these to compute the coupling.
In addition, in the case the polarisation is not immediately known (i.e.
if raytracing.ipol == .false.), this change postpones the computation of
the Jones vector (ext, eyt) from the launch point, if the magnetic
equilibrium is available, to when the ray actually crosses the
plasma boundary.
The original code, besides being strictly incorrect, can lead to
non-negligible alterations to the coupling. This change also mean:
1. most of the functionality of `set_pol` has been merged with
`plasma_in`
2. the polarisation is undefined and the Jones vector is set to the
placeholder value [1, 0] till `plasma_im` is called
Finally, `polarcold` is removed because it's unused.
2024-03-02 17:32:03 +01:00
taus ( jk , child_index_rt : child_index_rt + 1 ) = tau1 ( jk ) + tau0 ( jk ) ! . starting tau for next O-mode pass
cpls ( jk , child_index_rt ) = cpl1 ( jk ) * cpl ( 1 ) ! . cumulative coupling for next O-mode pass
cpls ( jk , child_index_rt + 1 ) = cpl1 ( jk ) * cpl ( 2 ) ! . cumulative coupling for next X-mode pass
2022-05-10 12:36:37 +02:00
if ( jk == 1 ) then ! . polarization angles at plasma boundary for central ray
fix coupling for subsequent beams
In situations when multiple beams are traced, either when allowing
multiple plasma crossings (raytracing.ipass > 0) or the initial polarisation
is mixed (raytracing.ipol == .true.), the couplings of all but the first
beam (with least index_rt) were invalid.
The bug is due to the re-use of the psipol,chipol variables as the beams
are traced sequentially over the beam_loop. For the first beam being
traced the psipol,chipol are correctly initialised to the user-defined
value and the resulting coupling is correct.
However, in each subsequent beam the values were not set to those of the
parent beam (or to the user-defined value in the case of the first X
mode beam), but to those of the previous beams (current index_rt - 1).
This change repurposes the psipv,chipv arrays to store the polarisation
of the parent beams, including the initial user-defined value and makes
plasma_in always use these to compute the coupling.
In addition, in the case the polarisation is not immediately known (i.e.
if raytracing.ipol == .false.), this change postpones the computation of
the Jones vector (ext, eyt) from the launch point, if the magnetic
equilibrium is available, to when the ray actually crosses the
plasma boundary.
The original code, besides being strictly incorrect, can lead to
non-negligible alterations to the coupling. This change also mean:
1. most of the functionality of `set_pol` has been merged with
`plasma_in`
2. the polarisation is undefined and the Jones vector is set to the
placeholder value [1, 0] till `plasma_im` is called
Finally, `polarcold` is removed because it's unused.
2024-03-02 17:32:03 +01:00
psipv ( child_index_rt : child_index_rt + 1 ) = psipol
chipv ( child_index_rt : child_index_rt + 1 ) = chipol
2019-03-26 15:21:22 +01:00
end if
2019-03-28 10:50:28 +01:00
else ! * 1st entrance on 2nd+ pass (ray hasn't entered in plasma since end of previous pass) => continue current pass
2022-05-10 12:36:37 +02:00
cpl = [ zero , zero ]
2019-03-26 15:21:22 +01:00
end if
end if
2022-05-10 12:36:37 +02:00
2019-03-26 15:21:22 +01:00
else if ( ext_pl ) then ! ray exits plasma
2022-05-26 02:33:55 +02:00
write ( msg , '(" ray ", g0, " left plasma")' ) jk
call log_debug ( msg , mod = 'gray_core' , proc = 'gray_main' )
2019-03-26 15:21:22 +01:00
call plasma_out ( jk , xv , anv , bres , sox , iop , ext , eyt )
end if
2022-05-10 12:36:37 +02:00
2019-03-26 15:21:22 +01:00
if ( ent_wl ) then ! ray enters vessel
2019-03-28 10:50:28 +01:00
iow ( jk ) = iow ( jk ) + 1 ! * out->in
2022-05-10 12:36:37 +02:00
2019-03-26 15:21:22 +01:00
else if ( ext_wl ) then ! ray exit vessel
2024-07-30 10:57:07 +02:00
call wall_out ( jk , data % equilibrium % limiter , ins_pl , xv , anv , &
params % raytracing % dst , bres , sox , psipol , chipol , &
iow , iop , ext , eyt )
2022-05-10 12:36:37 +02:00
yw ( : , jk ) = [ xv , anv ] ! * updated coordinates (reflected)
2019-03-26 15:21:22 +01:00
igrad_b = 0 ! * switch to ray-tracing
2022-05-10 12:36:37 +02:00
2024-08-14 10:47:39 +02:00
call ywppla_upd ( params , plasma , xv , anv , gri ( : , jk ) , ggri ( : , : , jk ) , &
sox , bres , xgcn , ypw ( : , jk ) , psinv , dens , btot , &
bv , xg , yg , derxg , anpl , anpr , ddr , ddi , dersdst , &
2024-07-07 13:18:55 +02:00
derdnm , ierrn , igrad_b ) ! * update derivatives after reflection
2019-03-26 15:21:22 +01:00
if ( ierrn / = 0 ) then ! * update global error code and print message
2021-12-15 02:31:09 +01:00
error = ior ( error , ierrn )
2022-07-14 00:38:34 +02:00
call print_err_raytracing ( ierrn , i , anpl )
2019-03-26 15:21:22 +01:00
end if
2022-05-10 12:36:37 +02:00
if ( jk == 1 . and . ip == 1 ) then ! * 1st pass, polarization angles at reflection for central ray
2019-03-26 15:21:22 +01:00
psipv ( index_rt ) = psipol
chipv ( index_rt ) = chipol
end if
2022-05-10 12:36:37 +02:00
2019-03-28 10:50:28 +01:00
if ( ins_pl ) then ! * plasma-wall overlapping => wall+plasma crossing => end of current pass
2019-03-26 15:21:22 +01:00
iwait ( jk ) = . true . ! + stop advancement and H&CD computation for current ray
2022-05-10 12:36:37 +02:00
if ( ip < params % raytracing % ipass ) then ! + not last pass
yynext ( : , jk , index_rt ) = [ xv , anv ] ! . starting coordinates
2019-03-26 15:21:22 +01:00
yypnext ( : , jk , index_rt ) = ypw ( : , jk ) ! for next pass = reflection point
stnext ( jk , index_rt ) = stv ( jk ) ! . starting step for next pass = step after reflection
2022-05-10 12:36:37 +02:00
fix coupling for subsequent beams
In situations when multiple beams are traced, either when allowing
multiple plasma crossings (raytracing.ipass > 0) or the initial polarisation
is mixed (raytracing.ipol == .true.), the couplings of all but the first
beam (with least index_rt) were invalid.
The bug is due to the re-use of the psipol,chipol variables as the beams
are traced sequentially over the beam_loop. For the first beam being
traced the psipol,chipol are correctly initialised to the user-defined
value and the resulting coupling is correct.
However, in each subsequent beam the values were not set to those of the
parent beam (or to the user-defined value in the case of the first X
mode beam), but to those of the previous beams (current index_rt - 1).
This change repurposes the psipv,chipv arrays to store the polarisation
of the parent beams, including the initial user-defined value and makes
plasma_in always use these to compute the coupling.
In addition, in the case the polarisation is not immediately known (i.e.
if raytracing.ipol == .false.), this change postpones the computation of
the Jones vector (ext, eyt) from the launch point, if the magnetic
equilibrium is available, to when the ray actually crosses the
plasma boundary.
The original code, besides being strictly incorrect, can lead to
non-negligible alterations to the coupling. This change also mean:
1. most of the functionality of `set_pol` has been merged with
`plasma_in`
2. the polarisation is undefined and the Jones vector is set to the
placeholder value [1, 0] till `plasma_im` is called
Finally, `polarcold` is removed because it's unused.
2024-03-02 17:32:03 +01:00
call plasma_in ( jk , xv , anv , bres , sox , cpl , psipol , chipol , & ! . ray re-enters plasma after reflection
iop , ext , eyt , perfect = . false . )
2022-05-10 12:36:37 +02:00
if ( cpl ( 1 ) < etaucr ) then ! . low coupled power for O-mode? => de-activate derived rays
2024-07-07 13:18:55 +02:00
call turnoffray ( jk , ip + 1 , npass , 2 * ib - 1 , iroff )
2019-03-26 15:21:22 +01:00
if ( cpl ( 1 ) . le . comp_tiny ) cpl ( 1 ) = etaucr
end if
2022-05-10 12:36:37 +02:00
if ( cpl ( 2 ) < etaucr ) then ! . low coupled power for X-mode? => de-activate derived rays
2024-07-07 13:18:55 +02:00
call turnoffray ( jk , ip + 1 , npass , 2 * ib , iroff )
2019-03-26 15:21:22 +01:00
if ( cpl ( 2 ) . le . comp_tiny ) cpl ( 2 ) = etaucr
end if
2022-05-10 12:36:37 +02:00
fix coupling for subsequent beams
In situations when multiple beams are traced, either when allowing
multiple plasma crossings (raytracing.ipass > 0) or the initial polarisation
is mixed (raytracing.ipol == .true.), the couplings of all but the first
beam (with least index_rt) were invalid.
The bug is due to the re-use of the psipol,chipol variables as the beams
are traced sequentially over the beam_loop. For the first beam being
traced the psipol,chipol are correctly initialised to the user-defined
value and the resulting coupling is correct.
However, in each subsequent beam the values were not set to those of the
parent beam (or to the user-defined value in the case of the first X
mode beam), but to those of the previous beams (current index_rt - 1).
This change repurposes the psipv,chipv arrays to store the polarisation
of the parent beams, including the initial user-defined value and makes
plasma_in always use these to compute the coupling.
In addition, in the case the polarisation is not immediately known (i.e.
if raytracing.ipol == .false.), this change postpones the computation of
the Jones vector (ext, eyt) from the launch point, if the magnetic
equilibrium is available, to when the ray actually crosses the
plasma boundary.
The original code, besides being strictly incorrect, can lead to
non-negligible alterations to the coupling. This change also mean:
1. most of the functionality of `set_pol` has been merged with
`plasma_in`
2. the polarisation is undefined and the Jones vector is set to the
placeholder value [1, 0] till `plasma_im` is called
Finally, `polarcold` is removed because it's unused.
2024-03-02 17:32:03 +01:00
taus ( jk , child_index_rt : child_index_rt + 1 ) = tau1 ( jk ) + tau0 ( jk ) ! . starting tau for next O-mode pass
cpls ( jk , child_index_rt ) = cpl1 ( jk ) * cpl ( 1 ) ! . cumulative coupling for next O-mode pass
cpls ( jk , child_index_rt + 1 ) = cpl1 ( jk ) * cpl ( 2 ) ! . cumulative coupling for next X-mode pass
2019-03-26 15:21:22 +01:00
2022-05-10 12:36:37 +02:00
if ( jk == 1 ) then ! + polarization angles at plasma boundary for central ray
fix coupling for subsequent beams
In situations when multiple beams are traced, either when allowing
multiple plasma crossings (raytracing.ipass > 0) or the initial polarisation
is mixed (raytracing.ipol == .true.), the couplings of all but the first
beam (with least index_rt) were invalid.
The bug is due to the re-use of the psipol,chipol variables as the beams
are traced sequentially over the beam_loop. For the first beam being
traced the psipol,chipol are correctly initialised to the user-defined
value and the resulting coupling is correct.
However, in each subsequent beam the values were not set to those of the
parent beam (or to the user-defined value in the case of the first X
mode beam), but to those of the previous beams (current index_rt - 1).
This change repurposes the psipv,chipv arrays to store the polarisation
of the parent beams, including the initial user-defined value and makes
plasma_in always use these to compute the coupling.
In addition, in the case the polarisation is not immediately known (i.e.
if raytracing.ipol == .false.), this change postpones the computation of
the Jones vector (ext, eyt) from the launch point, if the magnetic
equilibrium is available, to when the ray actually crosses the
plasma boundary.
The original code, besides being strictly incorrect, can lead to
non-negligible alterations to the coupling. This change also mean:
1. most of the functionality of `set_pol` has been merged with
`plasma_in`
2. the polarisation is undefined and the Jones vector is set to the
placeholder value [1, 0] till `plasma_im` is called
Finally, `polarcold` is removed because it's unused.
2024-03-02 17:32:03 +01:00
psipv ( child_index_rt : child_index_rt + 1 ) = psipol
chipv ( child_index_rt : child_index_rt + 1 ) = chipol
2019-03-26 15:21:22 +01:00
end if
end if
end if
end if
2022-05-10 12:36:37 +02:00
2019-03-26 15:21:22 +01:00
iopmin = min ( iopmin , iop ( jk ) )
2022-05-10 12:36:37 +02:00
if ( ip < params % raytracing % ipass ) then ! not last pass
2019-03-28 10:50:28 +01:00
yw0 ( : , jk ) = yw ( : , jk ) ! * store current coordinates in case
ypw0 ( : , jk ) = ypw ( : , jk ) ! current pass ends on next step
2019-03-26 15:21:22 +01:00
end if
2022-05-10 12:36:37 +02:00
! Compute ECRH&CD if (inside plasma & power available>0 & ray still active)
! Note: power check is τ + τ₀ + log(coupling O/X) < τ_critic
if ( ierrn == 0 . and . params % ecrh_cd % iwarm > 0 . and . ins_pl . and . &
2019-03-26 15:21:22 +01:00
( tau1 ( jk ) + tau0 ( jk ) + lgcpl1 ( jk ) ) < = taucr . and . . not . iwait ( jk ) ) then ! H&CD computation check
2024-08-14 10:47:39 +02:00
tekev = plasma % temp ( psinv )
2022-05-20 13:10:49 +02:00
block
complex ( wp_ ) :: Npr_warm
2024-08-14 10:47:39 +02:00
call alpha_effj ( params % ecrh_cd , plasma , psinv , xg , yg , dens , &
tekev , ak0 , bres , derdnm , anpl , anpr , sox , &
Npr_warm , alpha , didp , nharm , nhf , iokhawa , &
ierrhcd )
2022-05-20 13:10:49 +02:00
anprre = Npr_warm % re
anprim = Npr_warm % im
2022-07-14 00:38:34 +02:00
if ( ierrhcd / = 0 ) then
error = ior ( error , ierrhcd )
call print_err_ecrh_cd ( ierrhcd , i , Npr_warm , alpha )
end if
2022-05-20 13:10:49 +02:00
end block
2019-03-26 15:21:22 +01:00
else
tekev = zero
alpha = zero
didp = zero
anprim = zero
anprre = anpr
nharm = 0
nhf = 0
iokhawa = 0
end if
if ( nharm > 0 ) iiv ( jk ) = i
2022-05-10 12:36:37 +02:00
2019-03-26 15:21:22 +01:00
psjki ( jk , i ) = psinv
2022-05-10 12:36:37 +02:00
! Computation of the ray τ, dP/ds, P(s), dI/ds, I(s)
! optical depth: τ = ∫α(s)ds using the trapezoid rule
tau = tau0 ( jk ) + 0.5_wp_ * ( alphaabs0 ( jk ) + alpha ) * dersdst * params % raytracing % dst
pow = p0ray ( jk ) * exp ( - tau ) ! residual power: P = P₀exp(-τ)
ppabs ( jk , i ) = p0ray ( jk ) - pow ! absorbed power: P_abs = P₀ - P
2023-03-29 11:19:00 +02:00
dids = didp * pow * alpha ! current driven: dI/ds = dI/dP⋅dP/ds = dI/dP⋅P⋅α
2022-05-10 12:36:37 +02:00
! current: I = ∫dI/ds⋅ds using the trapezoid rule
ccci ( jk , i ) = ccci0 ( jk ) + 0.5_wp_ * ( dids0 ( jk ) + dids ) * dersdst * params % raytracing % dst
tau0 ( jk ) = tau
alphaabs0 ( jk ) = alpha
dids0 ( jk ) = dids
ccci0 ( jk ) = ccci ( jk , i )
2019-03-28 10:50:28 +01:00
if ( iwait ( jk ) ) then ! copy values from last pass for inactive ray
2022-05-10 12:36:37 +02:00
ppabs ( jk , i : params % raytracing % nstep ) = ppabs ( jk , i - 1 )
ccci ( jk , i : params % raytracing % nstep ) = ccci ( jk , i - 1 )
psjki ( jk , i : params % raytracing % nstep ) = psjki ( jk , i - 1 )
2019-03-26 15:21:22 +01:00
else
2024-07-07 13:18:55 +02:00
call store_ray_data ( params , results % tables , &
2024-05-02 00:47:59 +02:00
i , jk , stv ( jk ) , p0ray ( jk ) , xv , psinv , btot , bv , ak0 , &
anpl , anpr , anv , anprim , dens , tekev , alpha , tau , dids , &
nharm , nhf , iokhawa , index_rt , ddr , ddi , xg , yg , derxg ) ! p0ray/etau1 [dids normalization] = fraction of p0 coupled to this ray (not including absorption from previous passes)
2019-03-26 15:21:22 +01:00
end if
2022-05-10 12:36:37 +02:00
end do rays_loop
! ============ rays loop END ============
if ( i == params % raytracing % nstep ) then ! step limit reached?
do jk = 1 , params % raytracing % nray
2024-07-07 13:18:55 +02:00
if ( iop ( jk ) < 3 ) call turnoffray ( jk , ip , npass , ib , iroff ) ! * ray hasn't exited+reentered the plasma by last step => stop ray
2019-03-26 15:21:22 +01:00
end do
end if
2022-05-10 12:36:37 +02:00
! print ray positions for j=nrayr in local reference system
if ( mod ( i , params % output % istpr ) == 0 ) then
if ( params % raytracing % nray > 1 . and . all ( . not . iwait ) ) &
2024-05-02 00:47:59 +02:00
call store_beam_shape ( params % raytracing , results % tables , stv , yw )
2019-03-26 15:21:22 +01:00
end if
2022-05-10 12:36:37 +02:00
! test whether further trajectory integration is unnecessary
call vmaxmin ( tau1 + tau0 + lgcpl1 , params % raytracing % nray , taumn , taumx ) ! test on tau + coupling
2022-07-14 00:38:34 +02:00
if ( is_critical ( error ) ) then ! stop propagation for current beam
2019-03-26 15:21:22 +01:00
istop_pass = istop_pass + 1 ! * +1 non propagating beam
2024-07-07 13:18:55 +02:00
if ( ip < params % raytracing % ipass ) call turnoffray ( 0 , ip , npass , ib , iroff ) ! * de-activate derived beams
2019-03-26 15:21:22 +01:00
exit
2019-03-28 10:50:28 +01:00
else if ( all ( iwait ) ) then ! all rays in current beam are waiting for next pass => do not increase istop_pass
2019-03-26 15:21:22 +01:00
exit
2015-11-19 19:20:58 +01:00
end if
2022-05-10 12:36:37 +02:00
end do propagation_loop
2021-12-18 18:57:38 +01:00
call log_debug ( ' propagation loop end' , mod = 'gray_core' , proc = 'gray_main' )
2022-05-10 12:36:37 +02:00
! ======== propagation loop END ========
! print all ray positions in local reference system
2024-05-02 00:47:59 +02:00
if ( params % raytracing % nray > 1 . and . all ( . not . iwait ) ) &
call store_beam_shape ( params % raytracing , results % tables , &
stv , yw , full = . true . )
2022-05-10 12:36:37 +02:00
! =========== post-proc BEGIN ===========
! compute total absorbed power and driven current for current beam
if ( i > params % raytracing % nstep ) i = params % raytracing % nstep
2019-03-26 15:21:22 +01:00
pabs_beam = sum ( ppabs ( : , i ) )
icd_beam = sum ( ccci ( : , i ) )
2022-05-10 12:36:37 +02:00
call vmaxmin ( tau0 , params % raytracing % nray , taumn , taumx ) ! taumn,taumx for print
2024-01-30 10:14:24 +01:00
if ( params % equilibrium % iequil / = EQ_VACUUM ) then
! compute power and current density profiles for all rays
2024-07-07 13:18:55 +02:00
call spec ( psjki , ppabs , ccci , iiv , pabs_beam , &
icd_beam , dpdv_beam , jphi_beam , jcd_beam , &
pins_beam , currins_beam )
2024-01-30 10:14:24 +01:00
end if
2022-05-10 12:36:37 +02:00
2019-03-26 15:21:22 +01:00
pabs_pass ( iox ) = pabs_pass ( iox ) + pabs_beam ! 0D results for current pass, sum on O/X mode beams
icd_pass ( iox ) = icd_pass ( iox ) + icd_beam
2022-05-10 12:36:37 +02:00
if ( ip < params % raytracing % ipass . and . iopmin > 2 ) then ! not last pass AND at least one ray re-entered plasma
fix coupling for subsequent beams
In situations when multiple beams are traced, either when allowing
multiple plasma crossings (raytracing.ipass > 0) or the initial polarisation
is mixed (raytracing.ipol == .true.), the couplings of all but the first
beam (with least index_rt) were invalid.
The bug is due to the re-use of the psipol,chipol variables as the beams
are traced sequentially over the beam_loop. For the first beam being
traced the psipol,chipol are correctly initialised to the user-defined
value and the resulting coupling is correct.
However, in each subsequent beam the values were not set to those of the
parent beam (or to the user-defined value in the case of the first X
mode beam), but to those of the previous beams (current index_rt - 1).
This change repurposes the psipv,chipv arrays to store the polarisation
of the parent beams, including the initial user-defined value and makes
plasma_in always use these to compute the coupling.
In addition, in the case the polarisation is not immediately known (i.e.
if raytracing.ipol == .false.), this change postpones the computation of
the Jones vector (ext, eyt) from the launch point, if the magnetic
equilibrium is available, to when the ray actually crosses the
plasma boundary.
The original code, besides being strictly incorrect, can lead to
non-negligible alterations to the coupling. This change also mean:
1. most of the functionality of `set_pol` has been merged with
`plasma_in`
2. the polarisation is undefined and the Jones vector is set to the
placeholder value [1, 0] till `plasma_im` is called
Finally, `polarcold` is removed because it's unused.
2024-03-02 17:32:03 +01:00
cpl_beam1 = sum ( &
p0ray * exp ( - tau0 ) * cpls ( : , child_index_rt ) / cpl1 , MASK = iop > 2 ) / &
sum ( p0ray * exp ( - tau0 ) , MASK = iop > 2 ) ! * average O-mode coupling for next beam (on active rays)
2019-03-28 12:33:43 +01:00
cpl_beam2 = one - cpl_beam1 ! * average X-mode coupling for next beam
2022-05-10 12:36:37 +02:00
if ( iop ( 1 ) > 2 ) then ! * central ray O/X-mode coupling for next beam
fix coupling for subsequent beams
In situations when multiple beams are traced, either when allowing
multiple plasma crossings (raytracing.ipass > 0) or the initial polarisation
is mixed (raytracing.ipol == .true.), the couplings of all but the first
beam (with least index_rt) were invalid.
The bug is due to the re-use of the psipol,chipol variables as the beams
are traced sequentially over the beam_loop. For the first beam being
traced the psipol,chipol are correctly initialised to the user-defined
value and the resulting coupling is correct.
However, in each subsequent beam the values were not set to those of the
parent beam (or to the user-defined value in the case of the first X
mode beam), but to those of the previous beams (current index_rt - 1).
This change repurposes the psipv,chipv arrays to store the polarisation
of the parent beams, including the initial user-defined value and makes
plasma_in always use these to compute the coupling.
In addition, in the case the polarisation is not immediately known (i.e.
if raytracing.ipol == .false.), this change postpones the computation of
the Jones vector (ext, eyt) from the launch point, if the magnetic
equilibrium is available, to when the ray actually crosses the
plasma boundary.
The original code, besides being strictly incorrect, can lead to
non-negligible alterations to the coupling. This change also mean:
1. most of the functionality of `set_pol` has been merged with
`plasma_in`
2. the polarisation is undefined and the Jones vector is set to the
placeholder value [1, 0] till `plasma_im` is called
Finally, `polarcold` is removed because it's unused.
2024-03-02 17:32:03 +01:00
cpl_cbeam1 = cpls ( 1 , child_index_rt ) / cpl1 ( 1 )
2019-03-28 12:33:43 +01:00
cpl_cbeam2 = one - cpl_cbeam1
end if
else ! last pass OR no ray re-entered plasma
2019-03-26 15:21:22 +01:00
cpl_beam1 = zero
cpl_beam2 = zero
2015-11-18 17:34:33 +01:00
end if
2021-12-18 18:57:38 +01:00
! print final results for pass on screen
call log_info ( ' partial results:' , mod = 'gray_core' , proc = 'gray_main' )
2022-05-26 02:33:55 +02:00
write ( msg , '(" final step:", x,a,g0, x,a,g0.4)' ) 'n=' , i , '(s, ct, Sr)=' , stv ( 1 )
2021-12-18 18:57:38 +01:00
call log_info ( msg , mod = 'gray_core' , proc = 'gray_main' )
write ( msg , '(3x,a,2(x,a,"=",g0.4))' ) 'optical depth:' , 'τ_min' , taumn , 'τ_max' , taumx
call log_info ( msg , mod = 'gray_core' , proc = 'gray_main' )
write ( msg , '(3x,a,g0.3," MW")' ) 'absoption: P=' , pabs_beam
call log_info ( msg , mod = 'gray_core' , proc = 'gray_main' )
2023-10-04 16:56:05 +02:00
write ( msg , '(3x,a,g0.3," kA")' ) 'current drive: I=' , icd_beam * 1.0e3_wp_
2021-12-18 18:57:38 +01:00
call log_info ( msg , mod = 'gray_core' , proc = 'gray_main' )
2022-05-10 12:36:37 +02:00
if ( ip < params % raytracing % ipass ) then
2021-12-18 18:57:38 +01:00
write ( msg , '(3x,a,(g0.4,", ",g0.4))' ) & ! average coupling for next O/X beams (=0 if no ray re-entered plasma)
'next couplings [O,X mode]: c=' , cpl_beam1 , cpl_beam2
call log_info ( msg , mod = 'gray_core' , proc = 'gray_main' )
if ( iop ( 1 ) > 2 ) then
write ( msg , '(3x,a,(g0.4,", ",g0.4))' ) &
'coupling [ctr ray, O/X]:' , cpl_cbeam1 , cpl_cbeam2 ! central ray coupling for next O/X beams
fix coupling for subsequent beams
In situations when multiple beams are traced, either when allowing
multiple plasma crossings (raytracing.ipass > 0) or the initial polarisation
is mixed (raytracing.ipol == .true.), the couplings of all but the first
beam (with least index_rt) were invalid.
The bug is due to the re-use of the psipol,chipol variables as the beams
are traced sequentially over the beam_loop. For the first beam being
traced the psipol,chipol are correctly initialised to the user-defined
value and the resulting coupling is correct.
However, in each subsequent beam the values were not set to those of the
parent beam (or to the user-defined value in the case of the first X
mode beam), but to those of the previous beams (current index_rt - 1).
This change repurposes the psipv,chipv arrays to store the polarisation
of the parent beams, including the initial user-defined value and makes
plasma_in always use these to compute the coupling.
In addition, in the case the polarisation is not immediately known (i.e.
if raytracing.ipol == .false.), this change postpones the computation of
the Jones vector (ext, eyt) from the launch point, if the magnetic
equilibrium is available, to when the ray actually crosses the
plasma boundary.
The original code, besides being strictly incorrect, can lead to
non-negligible alterations to the coupling. This change also mean:
1. most of the functionality of `set_pol` has been merged with
`plasma_in`
2. the polarisation is undefined and the Jones vector is set to the
placeholder value [1, 0] till `plasma_im` is called
Finally, `polarcold` is removed because it's unused.
2024-03-02 17:32:03 +01:00
call log_info ( msg , mod = 'gray_core' , proc = 'gray_main' )
2021-12-18 18:57:38 +01:00
end if
2019-03-26 15:21:22 +01:00
end if
2021-12-18 18:57:38 +01:00
2024-01-30 10:14:24 +01:00
if ( params % equilibrium % iequil / = EQ_VACUUM ) then
2024-05-02 00:47:59 +02:00
call store_ec_profiles ( &
results % tables % ec_profiles , rhop_tab , rhot_tab , jphi_beam , &
jcd_beam , dpdv_beam , currins_beam , pins_beam , ip )
2024-01-30 10:14:24 +01:00
call postproc_profiles ( pabs_beam , icd_beam , rhot_tab , dpdv_beam , &
jphi_beam , rhotpav , drhotpav , rhotjava , drhotjava , dpdvp , jphip , &
rhotp , drhotp , rhotj , drhotj , dpdvmx , jphimx , ratjamx , ratjbmx ) ! *compute profiles width for current beam
2022-05-10 12:36:37 +02:00
2024-05-02 00:47:59 +02:00
if ( results % tables % summary % active ) then
call results % tables % summary % append ( [ &
wrap ( icd_beam ) , wrap ( pabs_beam ) , wrap ( jphip ) , wrap ( dpdvp ) , &
wrap ( rhotj ) , wrap ( rhotjava ) , wrap ( rhotp ) , wrap ( rhotpav ) , &
wrap ( drhotjava ) , wrap ( drhotpav ) , wrap ( ratjamx ) , wrap ( ratjbmx ) , &
wrap ( stv ( 1 ) ) , wrap ( psipv ( index_rt ) ) , wrap ( chipv ( index_rt ) ) , &
wrap ( index_rt ) , wrap ( jphimx ) , wrap ( dpdvmx ) , wrap ( drhotj ) , &
wrap ( drhotp ) , wrap ( sum ( p0ray ) ) , wrap ( cpl_beam1 ) , wrap ( cpl_beam2 ) ] ) ! *print 0D results for current beam
end if
2024-01-30 10:14:24 +01:00
end if
2022-05-10 12:36:37 +02:00
! ============ post-proc END ============
end do beam_loop
2021-12-18 18:57:38 +01:00
call log_debug ( 'beam loop end' , mod = 'gray_core' , proc = 'gray_main' )
2022-05-10 12:36:37 +02:00
! ============ beam loop END ============
! ======= cumulative prints BEGIN =======
2021-12-15 02:31:09 +01:00
results % pabs = results % pabs + sum ( pabs_pass ) ! *final results (O+X) [gray_main output]
results % icd = results % icd + sum ( icd_pass )
2021-12-18 18:57:38 +01:00
! print final results for pass on screen
call log_info ( ' comulative results:' , mod = 'gray_core' , proc = 'gray_main' )
write ( msg , '(" absoption [O,X mode] P=",g0.4,", ",g0.4," MW")' ) &
pabs_pass ( 1 ) , pabs_pass ( 2 )
call log_info ( msg , mod = 'gray_core' , proc = 'gray_main' )
write ( msg , '(" current drive [O,X mode] I=",g0.4,", ",g0.4," kA")' ) &
icd_pass ( 1 ) * 1.0e3_wp_ , icd_pass ( 2 ) * 1.0e3_wp_
call log_info ( msg , mod = 'gray_core' , proc = 'gray_main' )
2022-05-10 12:36:37 +02:00
! ======== cumulative prints END ========
2019-03-26 15:21:22 +01:00
if ( istop_pass == nbeam_pass ) exit ! no active beams
2022-05-10 12:36:37 +02:00
end do main_loop
2021-12-18 18:57:38 +01:00
call log_debug ( 'pass loop end' , mod = 'gray_core' , proc = 'gray_main' )
2022-05-10 12:36:37 +02:00
! ============ main loop END ============
2019-03-26 15:21:22 +01:00
2024-05-02 00:47:59 +02:00
! Free memory
2016-06-01 15:49:35 +02:00
call dealloc_surfvec
call dealloc_pec
2024-04-23 17:00:40 +02:00
end block
end associate
2015-11-23 18:55:27 +01:00
end subroutine gray_main
2015-11-18 17:34:33 +01:00
2021-12-15 02:30:55 +01:00
2015-11-19 19:20:58 +01:00
subroutine vectinit ( psjki , ppabs , ccci , tau0 , alphaabs0 , dids0 , ccci0 , iiv )
2021-12-19 16:39:19 +01:00
use const_and_precisions , only : zero
2015-11-18 17:34:33 +01:00
! arguments
2015-11-19 19:20:58 +01:00
real ( wp_ ) , dimension ( : , : ) , intent ( out ) :: psjki , ppabs , ccci
real ( wp_ ) , dimension ( : ) , intent ( out ) :: tau0 , alphaabs0 , dids0 , ccci0
2015-11-18 17:34:33 +01:00
integer , dimension ( : ) , intent ( out ) :: iiv
!! common/external functions/variables
! integer :: jclosest
! real(wp_), dimension(3) :: anwcl,xwcl
!
! common/refln/anwcl,xwcl,jclosest
!
! jclosest=nrayr+1
! anwcl(1:3)=0.0_wp_
! xwcl(1:3)=0.0_wp_
2015-11-19 19:20:58 +01:00
psjki = zero
ppabs = zero
ccci = zero
tau0 = zero
alphaabs0 = zero
dids0 = zero
ccci0 = zero
iiv = 1
2015-11-18 17:34:33 +01:00
end subroutine vectinit
2022-05-10 12:36:37 +02:00
subroutine ic_gb ( params , anv0c , ak0 , ywrk0 , ypwrk0 , &
2024-05-02 00:47:59 +02:00
stv , xc0 , du10 , gri , ggri , index_rt , &
tables )
2022-05-10 12:36:37 +02:00
! beam tracing initial conditions igrad=1
! !!!!!! check ray tracing initial conditions igrad=0 !!!!!!
2021-12-19 16:39:19 +01:00
use const_and_precisions , only : zero , one , pi , half , two , degree , ui = > im
2024-05-02 00:47:59 +02:00
use gray_params , only : gray_parameters , gray_tables
use types , only : table
2024-07-07 13:18:55 +02:00
use gray_tables , only : store_ray_data
2022-05-10 12:36:37 +02:00
! subroutine arguments
2024-07-07 13:18:55 +02:00
type ( gray_parameters ) , intent ( in ) :: params
real ( wp_ ) , dimension ( 3 ) , intent ( in ) :: anv0c
real ( wp_ ) , intent ( in ) :: ak0
real ( wp_ ) , dimension ( 6 , params % raytracing % nray ) , intent ( out ) :: ywrk0 , ypwrk0
real ( wp_ ) , dimension ( params % raytracing % nrayth * params % raytracing % nrayr ) , intent ( out ) :: stv
real ( wp_ ) , dimension ( 3 , params % raytracing % nrayth , params % raytracing % nrayr ) , intent ( out ) :: xc0 , du10
real ( wp_ ) , dimension ( 3 , params % raytracing % nray ) , intent ( out ) :: gri
real ( wp_ ) , dimension ( 3 , 3 , params % raytracing % nray ) , intent ( out ) :: ggri
integer , intent ( in ) :: index_rt
2022-05-10 12:36:37 +02:00
2024-05-02 00:47:59 +02:00
! tables for storing initial rays data
type ( gray_tables ) , intent ( inout ) , optional :: tables
2022-05-10 12:36:37 +02:00
! local variables
real ( wp_ ) , dimension ( 3 ) :: xv0c
real ( wp_ ) :: wcsi , weta , rcicsi , rcieta , phiw , phir
2015-11-18 17:34:33 +01:00
integer :: j , k , jk
real ( wp_ ) :: csth , snth , csps , snps , phiwrad , phirrad , csphiw , snphiw , alfak
real ( wp_ ) :: wwcsi , wweta , sk , sw , dk , dw , rci1 , ww1 , rci2 , ww2 , wwxx , wwyy , wwxy
real ( wp_ ) :: rcixx , rciyy , rcixy , dwwxx , dwwyy , dwwxy , d2wwxx , d2wwyy , d2wwxy
real ( wp_ ) :: drcixx , drciyy , drcixy , dr , da , ddfu , dcsiw , detaw , dx0t , dy0t
real ( wp_ ) :: x0t , y0t , z0t , dx0 , dy0 , dz0 , x0 , y0 , z0 , gxt , gyt , gzt , gr2
real ( wp_ ) :: gxxt , gyyt , gzzt , gxyt , gxzt , gyzt , dgr2xt , dgr2yt , dgr2zt
real ( wp_ ) :: dgr2x , dgr2y , dgr2z , pppx , pppy , denpp , ppx , ppy
real ( wp_ ) :: anzt , anxt , anyt , anx , any , anz , an20 , an0
real ( wp_ ) :: du1tx , du1ty , du1tz , denom , ddr , ddi
2024-07-07 13:18:55 +02:00
real ( wp_ ) , dimension ( params % raytracing % nrayr ) :: uj
real ( wp_ ) , dimension ( params % raytracing % nrayth ) :: sna , csa
2015-11-18 17:34:33 +01:00
complex ( wp_ ) :: sss , ddd , phic , qi1 , qi2 , tc , ts , qqxx , qqxy , qqyy , dqi1 , dqi2
complex ( wp_ ) :: dqqxx , dqqyy , dqqxy , d2qi1 , d2qi2 , d2qqxx , d2qqyy , d2qqxy
2022-05-10 12:36:37 +02:00
! initial beam parameters
xv0c = params % antenna % pos
wcsi = params % antenna % w ( 1 )
weta = params % antenna % w ( 2 )
rcicsi = params % antenna % ri ( 1 )
rcieta = params % antenna % ri ( 2 )
phiw = params % antenna % phi ( 1 )
phir = params % antenna % phi ( 2 )
2015-11-18 17:34:33 +01:00
csth = anv0c ( 3 )
snth = sqrt ( one - csth ** 2 )
if ( snth > zero ) then
csps = anv0c ( 2 ) / snth
snps = anv0c ( 1 ) / snth
else
csps = one
snps = zero
end if
2022-05-10 12:36:37 +02:00
! Gaussian beam: exp[-ik0 zt] exp[-i k0/2 S(xt,yt,zt)]
! xt,yt,zt, cartesian coordinate system with zt along the beamline and xt in the z = 0 plane
! S(xt,yt,zt) = S_real +i S_imag = Qxx(zt) xt^2 + Qyy(zt) yt^2 + 2 Qxy(zt) xt yt
! (csiw, etaw) and (csiR, etaR) intensity and phase ellipse, rotated by angle phiw and phiR
! S(xt,yt,zt) = csiR^2 / Rccsi +etaR^2 /Rceta - i (csiw^2 Wcsi +etaw^2 Weta)
! Rccsi,eta curvature radius at the launching point
! Wcsi,eta =2/(k0 wcsi,eta^2) with wcsi,eta^2 beam size at the launching point
2015-11-19 18:44:17 +01:00
2015-11-18 17:34:33 +01:00
phiwrad = phiw * degree
phirrad = phir * degree
csphiw = cos ( phiwrad )
snphiw = sin ( phiwrad )
2022-05-10 12:36:37 +02:00
!csphir = cos(phirrad)
!snphir = sin(phirrad)
2015-11-18 17:34:33 +01:00
wwcsi = two / ( ak0 * wcsi ** 2 )
wweta = two / ( ak0 * weta ** 2 )
if ( phir / = phiw ) then
2015-11-19 18:44:17 +01:00
sk = rcicsi + rcieta
sw = wwcsi + wweta
dk = rcicsi - rcieta
dw = wwcsi - wweta
ts = - ( dk * sin ( 2 * phirrad ) - ui * dw * sin ( 2 * phiwrad ) )
tc = ( dk * cos ( 2 * phirrad ) - ui * dw * cos ( 2 * phiwrad ) )
2022-07-15 00:09:36 +02:00
phic = half * atan ( ts / tc )
2015-11-19 18:44:17 +01:00
ddd = dk * cos ( 2 * ( phirrad + phic ) ) - ui * dw * cos ( 2 * ( phiwrad + phic ) )
sss = sk - ui * sw
qi1 = half * ( sss + ddd )
qi2 = half * ( sss - ddd )
2023-09-20 16:03:08 +02:00
rci1 = real ( qi1 )
rci2 = real ( qi2 )
ww1 = - imag ( qi1 )
ww2 = - imag ( qi2 )
2015-11-18 17:34:33 +01:00
else
rci1 = rcicsi
rci2 = rcieta
ww1 = wwcsi
ww2 = wweta
phic = - phiwrad
qi1 = rci1 - ui * ww1
qi2 = rci2 - ui * ww2
end if
2022-05-10 12:36:37 +02:00
!w01=sqrt(2.0_wp_/(ak0*ww1))
!d01=-rci1/(rci1**2+ww1**2)
!w02=sqrt(2.0_wp_/(ak0*ww2))
!d02=-rci2/(rci2**2+ww2**2)
2015-11-18 17:34:33 +01:00
qqxx = qi1 * cos ( phic ) ** 2 + qi2 * sin ( phic ) ** 2
qqyy = qi1 * sin ( phic ) ** 2 + qi2 * cos ( phic ) ** 2
2015-11-19 18:44:17 +01:00
qqxy = - ( qi1 - qi2 ) * sin ( phic ) * cos ( phic )
2023-09-20 16:03:08 +02:00
wwxx = - imag ( qqxx )
wwyy = - imag ( qqyy )
wwxy = - imag ( qqxy )
rcixx = real ( qqxx )
rciyy = real ( qqyy )
rcixy = real ( qqxy )
2015-11-18 17:34:33 +01:00
dqi1 = - qi1 ** 2
dqi2 = - qi2 ** 2
d2qi1 = 2 * qi1 ** 3
d2qi2 = 2 * qi2 ** 3
dqqxx = dqi1 * cos ( phic ) ** 2 + dqi2 * sin ( phic ) ** 2
dqqyy = dqi1 * sin ( phic ) ** 2 + dqi2 * cos ( phic ) ** 2
2015-11-19 18:44:17 +01:00
dqqxy = - ( dqi1 - dqi2 ) * sin ( phic ) * cos ( phic )
2015-11-18 17:34:33 +01:00
d2qqxx = d2qi1 * cos ( phic ) ** 2 + d2qi2 * sin ( phic ) ** 2
d2qqyy = d2qi1 * sin ( phic ) ** 2 + d2qi2 * cos ( phic ) ** 2
2015-11-19 18:44:17 +01:00
d2qqxy = - ( d2qi1 - d2qi2 ) * sin ( phic ) * cos ( phic )
2023-09-20 16:03:08 +02:00
dwwxx = - imag ( dqqxx )
dwwyy = - imag ( dqqyy )
dwwxy = - imag ( dqqxy )
d2wwxx = - imag ( d2qqxx )
d2wwyy = - imag ( d2qqyy )
d2wwxy = - imag ( d2qqxy )
drcixx = real ( dqqxx )
drciyy = real ( dqqyy )
drcixy = real ( dqqxy )
2015-11-18 17:34:33 +01:00
2024-07-07 13:18:55 +02:00
if ( params % raytracing % nrayr > 1 ) then
dr = params % raytracing % rwmax / ( params % raytracing % nrayr - 1 )
2015-11-18 17:34:33 +01:00
else
2024-07-07 13:18:55 +02:00
dr = 1
2015-11-18 17:34:33 +01:00
end if
2024-07-07 13:18:55 +02:00
ddfu = 2 * dr ** 2 / ak0
do j = 1 , params % raytracing % nrayr
2023-09-20 16:03:08 +02:00
uj ( j ) = real ( j - 1 , wp_ )
2022-05-10 12:36:37 +02:00
end do
2015-11-18 17:34:33 +01:00
2024-07-07 13:18:55 +02:00
da = 2 * pi / params % raytracing % nrayth
do k = 1 , params % raytracing % nrayth
2015-11-18 17:34:33 +01:00
alfak = ( k - 1 ) * da
sna ( k ) = sin ( alfak )
csa ( k ) = cos ( alfak )
end do
2022-05-10 12:36:37 +02:00
! central ray
2015-11-18 17:34:33 +01:00
jk = 1
gri ( : , 1 ) = zero
ggri ( : , : , 1 ) = zero
ywrk0 ( 1 : 3 , 1 ) = xv0c
ywrk0 ( 4 : 6 , 1 ) = anv0c
ypwrk0 ( 1 : 3 , 1 ) = anv0c
ypwrk0 ( 4 : 6 , 1 ) = zero
2022-05-10 12:36:37 +02:00
2024-07-07 13:18:55 +02:00
do k = 1 , params % raytracing % nrayth
2015-11-18 17:34:33 +01:00
dcsiw = dr * csa ( k ) * wcsi
detaw = dr * sna ( k ) * weta
dx0t = dcsiw * csphiw - detaw * snphiw
dy0t = dcsiw * snphiw + detaw * csphiw
du1tx = ( dx0t * wwxx + dy0t * wwxy ) / ddfu
du1ty = ( dx0t * wwxy + dy0t * wwyy ) / ddfu
xc0 ( : , k , 1 ) = xv0c
du10 ( 1 , k , 1 ) = du1tx * csps + snps * du1ty * csth
du10 ( 2 , k , 1 ) = - du1tx * snps + csps * du1ty * csth
du10 ( 3 , k , 1 ) = - du1ty * snth
end do
ddr = zero
ddi = zero
2022-05-10 12:36:37 +02:00
! loop on rays jk>1
2015-11-18 17:34:33 +01:00
j = 2
k = 0
2024-07-07 13:18:55 +02:00
do jk = 2 , params % raytracing % nray
2015-11-18 17:34:33 +01:00
k = k + 1
2024-07-07 13:18:55 +02:00
if ( k > params % raytracing % nrayth ) then
2015-11-18 17:34:33 +01:00
j = j + 1
k = 1
end if
2022-05-10 12:36:37 +02:00
!csiw=u*dcsiw
!etaw=u*detaw
!csir=x0t*csphir+y0t*snphir
!etar=-x0t*snphir+y0t*csphir
2015-11-18 17:34:33 +01:00
dcsiw = dr * csa ( k ) * wcsi
detaw = dr * sna ( k ) * weta
dx0t = dcsiw * csphiw - detaw * snphiw
dy0t = dcsiw * snphiw + detaw * csphiw
x0t = uj ( j ) * dx0t
y0t = uj ( j ) * dy0t
src/gray_core.f90: set initial ray position to z=0
Previously the ray initial positions were set to the wavefront
S_R(x,y,z) = 0, with (x,y) chosen such that S_I(x,y,0) = const.
The wavefront itself, however, was determined using the value of the
beam parameters (k_ξ, k_η, w_ξ, w_η, etc.) fixed at z=0, which is valid
only when the initial wavefront is approximately flat.
Moreover, since the ray are distributed according to S_I(z=0), this
choice creates an inconsistency between the phase (from S_R at z≠0) and
the power (from S_I at z=0) assigned to the rays.
Satisfying both conditions on S_R and S_I exactly is really hard;
however, given we do not really care about the phase and we want to
precisely track the power, so it's more sensible to simply set z=0.
This means that when integrating in the phase (idst=2), gray will no
longer construct wavefronts, but merely transport the initial phase
on the z=0 plane.
Note that k₀⋅s will still give the correct phase. so if necessary, a
wavefront could be reconstructed by interpolating the (s, x̅, y̅, z̅)
points.
2023-12-17 23:55:45 +01:00
z0t = 0
2015-11-18 17:34:33 +01:00
dx0 = x0t * csps + snps * ( y0t * csth + z0t * snth )
dy0 = - x0t * snps + csps * ( y0t * csth + z0t * snth )
dz0 = z0t * csth - y0t * snth
x0 = xv0c ( 1 ) + dx0
y0 = xv0c ( 2 ) + dy0
z0 = xv0c ( 3 ) + dz0
gxt = x0t * wwxx + y0t * wwxy
gyt = x0t * wwxy + y0t * wwyy
gzt = half * ( x0t ** 2 * dwwxx + y0t ** 2 * dwwyy ) + x0t * y0t * dwwxy
gr2 = gxt * gxt + gyt * gyt + gzt * gzt
gxxt = wwxx
gyyt = wwyy
gzzt = half * ( x0t ** 2 * d2wwxx + y0t ** 2 * d2wwyy ) + x0t * y0t * d2wwxy
gxyt = wwxy
gxzt = x0t * dwwxx + y0t * dwwxy
gyzt = x0t * dwwxy + y0t * dwwyy
dgr2xt = 2 * ( gxt * gxxt + gyt * gxyt + gzt * gxzt )
dgr2yt = 2 * ( gxt * gxyt + gyt * gyyt + gzt * gyzt )
dgr2zt = 2 * ( gxt * gxzt + gyt * gyzt + gzt * gzzt )
dgr2x = dgr2xt * csps + snps * ( dgr2yt * csth + dgr2zt * snth )
dgr2y = - dgr2xt * snps + csps * ( dgr2yt * csth + dgr2zt * snth )
dgr2z = dgr2zt * csth - dgr2yt * snth
2022-05-10 12:36:37 +02:00
2015-11-18 17:34:33 +01:00
gri ( 1 , jk ) = gxt * csps + snps * ( gyt * csth + gzt * snth )
gri ( 2 , jk ) = - gxt * snps + csps * ( gyt * csth + gzt * snth )
gri ( 3 , jk ) = gzt * csth - gyt * snth
ggri ( 1 , 1 , jk ) = gxxt * csps ** 2 &
+ snps ** 2 * ( gyyt * csth ** 2 + gzzt * snth ** 2 + 2 * snth * csth * gyzt ) &
+ 2 * snps * csps * ( gxyt * csth + gxzt * snth )
ggri ( 2 , 1 , jk ) = csps * snps &
* ( - gxxt + csth ** 2 * gyyt + snth ** 2 * gzzt + 2 * csth * snth * gyzt ) &
+ ( csps ** 2 - snps ** 2 ) * ( snth * gxzt + csth * gxyt )
ggri ( 3 , 1 , jk ) = csth * snth * snps * ( gzzt - gyyt ) + ( csth ** 2 - snth ** 2 ) &
* snps * gyzt + csps * ( csth * gxzt - snth * gxyt )
ggri ( 1 , 2 , jk ) = ggri ( 2 , 1 , jk )
ggri ( 2 , 2 , jk ) = gxxt * snps ** 2 &
+ csps ** 2 * ( gyyt * csth ** 2 + gzzt * snth ** 2 + 2 * snth * csth * gyzt ) &
- 2 * snps * csps * ( gxyt * csth + gxzt * snth )
ggri ( 3 , 2 , jk ) = csth * snth * csps * ( gzzt - gyyt ) + ( csth ** 2 - snth ** 2 ) &
* csps * gyzt + snps * ( snth * gxyt - csth * gxzt )
ggri ( 1 , 3 , jk ) = ggri ( 3 , 1 , jk )
ggri ( 2 , 3 , jk ) = ggri ( 3 , 2 , jk )
ggri ( 3 , 3 , jk ) = gzzt * csth ** 2 + gyyt * snth ** 2 - 2 * csth * snth * gyzt
du1tx = ( dx0t * wwxx + dy0t * wwxy ) / ddfu
du1ty = ( dx0t * wwxy + dy0t * wwyy ) / ddfu
du1tz = half * uj ( j ) * ( dx0t ** 2 * dwwxx + dy0t ** 2 * dwwyy + 2 * dx0t * dy0t * dwwxy ) / ddfu
du10 ( 1 , k , j ) = du1tx * csps + snps * ( du1ty * csth + du1tz * snth )
du10 ( 2 , k , j ) = - du1tx * snps + csps * ( du1ty * csth + du1tz * snth )
du10 ( 3 , k , j ) = du1tz * csth - du1ty * snth
pppx = x0t * rcixx + y0t * rcixy
pppy = x0t * rcixy + y0t * rciyy
denpp = pppx * gxt + pppy * gyt
if ( denpp / = zero ) then
ppx = - pppx * gzt / denpp
ppy = - pppy * gzt / denpp
else
ppx = zero
ppy = zero
end if
anzt = sqrt ( ( one + gr2 ) / ( one + ppx ** 2 + ppy ** 2 ) )
anxt = ppx * anzt
anyt = ppy * anzt
anx = anxt * csps + snps * ( anyt * csth + anzt * snth )
any = - anxt * snps + csps * ( anyt * csth + anzt * snth )
anz = anzt * csth - anyt * snth
an20 = one + gr2
an0 = sqrt ( an20 )
xc0 ( 1 , k , j ) = x0
xc0 ( 2 , k , j ) = y0
xc0 ( 3 , k , j ) = z0
ywrk0 ( 1 , jk ) = x0
ywrk0 ( 2 , jk ) = y0
ywrk0 ( 3 , jk ) = z0
ywrk0 ( 4 , jk ) = anx
ywrk0 ( 5 , jk ) = any
ywrk0 ( 6 , jk ) = anz
2022-05-10 12:36:37 +02:00
! integration variable
select case ( params % raytracing % idst )
case ( 0 )
! optical path: s
src/gray_core.f90: set initial ray position to z=0
Previously the ray initial positions were set to the wavefront
S_R(x,y,z) = 0, with (x,y) chosen such that S_I(x,y,0) = const.
The wavefront itself, however, was determined using the value of the
beam parameters (k_ξ, k_η, w_ξ, w_η, etc.) fixed at z=0, which is valid
only when the initial wavefront is approximately flat.
Moreover, since the ray are distributed according to S_I(z=0), this
choice creates an inconsistency between the phase (from S_R at z≠0) and
the power (from S_I at z=0) assigned to the rays.
Satisfying both conditions on S_R and S_I exactly is really hard;
however, given we do not really care about the phase and we want to
precisely track the power, so it's more sensible to simply set z=0.
This means that when integrating in the phase (idst=2), gray will no
longer construct wavefronts, but merely transport the initial phase
on the z=0 plane.
Note that k₀⋅s will still give the correct phase. so if necessary, a
wavefront could be reconstructed by interpolating the (s, x̅, y̅, z̅)
points.
2023-12-17 23:55:45 +01:00
stv ( jk ) = 0
2022-05-10 12:36:37 +02:00
denom = an0
case ( 1 )
! "time": c⋅t
src/gray_core.f90: set initial ray position to z=0
Previously the ray initial positions were set to the wavefront
S_R(x,y,z) = 0, with (x,y) chosen such that S_I(x,y,0) = const.
The wavefront itself, however, was determined using the value of the
beam parameters (k_ξ, k_η, w_ξ, w_η, etc.) fixed at z=0, which is valid
only when the initial wavefront is approximately flat.
Moreover, since the ray are distributed according to S_I(z=0), this
choice creates an inconsistency between the phase (from S_R at z≠0) and
the power (from S_I at z=0) assigned to the rays.
Satisfying both conditions on S_R and S_I exactly is really hard;
however, given we do not really care about the phase and we want to
precisely track the power, so it's more sensible to simply set z=0.
This means that when integrating in the phase (idst=2), gray will no
longer construct wavefronts, but merely transport the initial phase
on the z=0 plane.
Note that k₀⋅s will still give the correct phase. so if necessary, a
wavefront could be reconstructed by interpolating the (s, x̅, y̅, z̅)
points.
2023-12-17 23:55:45 +01:00
stv ( jk ) = 0
2022-05-10 12:36:37 +02:00
denom = one
case ( 2 )
! real eikonal: S_R
src/gray_core.f90: set initial ray position to z=0
Previously the ray initial positions were set to the wavefront
S_R(x,y,z) = 0, with (x,y) chosen such that S_I(x,y,0) = const.
The wavefront itself, however, was determined using the value of the
beam parameters (k_ξ, k_η, w_ξ, w_η, etc.) fixed at z=0, which is valid
only when the initial wavefront is approximately flat.
Moreover, since the ray are distributed according to S_I(z=0), this
choice creates an inconsistency between the phase (from S_R at z≠0) and
the power (from S_I at z=0) assigned to the rays.
Satisfying both conditions on S_R and S_I exactly is really hard;
however, given we do not really care about the phase and we want to
precisely track the power, so it's more sensible to simply set z=0.
This means that when integrating in the phase (idst=2), gray will no
longer construct wavefronts, but merely transport the initial phase
on the z=0 plane.
Note that k₀⋅s will still give the correct phase. so if necessary, a
wavefront could be reconstructed by interpolating the (s, x̅, y̅, z̅)
points.
2023-12-17 23:55:45 +01:00
stv ( jk ) = half * ( rcixx * x0t ** 2 + rciyy * y0t ** 2 ) + rcixy * x0t * y0t
2022-05-10 12:36:37 +02:00
denom = an20
2015-11-18 17:34:33 +01:00
end select
ypwrk0 ( 1 , jk ) = anx / denom
ypwrk0 ( 2 , jk ) = any / denom
ypwrk0 ( 3 , jk ) = anz / denom
ypwrk0 ( 4 , jk ) = dgr2x / ( 2 * denom )
ypwrk0 ( 5 , jk ) = dgr2y / ( 2 * denom )
ypwrk0 ( 6 , jk ) = dgr2z / ( 2 * denom )
ddr = anx ** 2 + any ** 2 + anz ** 2 - an20
ddi = 2 * ( anxt * gxt + anyt * gyt + anzt * gzt )
2024-05-02 00:47:59 +02:00
! save step "zero" data
if ( present ( tables ) ) &
2024-07-07 13:18:55 +02:00
call store_ray_data ( params , tables , &
2024-05-02 00:47:59 +02:00
i = 0 , jk = jk , s = stv ( jk ) , P0 = one , pos = xc0 ( : , k , j ) , &
psi_n = - one , B = zero , b_n = [ zero , zero , zero ] , k0 = ak0 , &
N_pl = zero , N_pr = zero , N = ywrk0 ( : , jk ) , N_pr_im = zero , &
n_e = zero , T_e = zero , alpha = zero , tau = zero , dIds = zero , &
nhm = 0 , nhf = 0 , iokhawa = 0 , index_rt = index_rt , &
lambda_r = ddr , lambda_i = ddi , X = zero , Y = zero , &
grad_X = [ zero , zero , zero ] )
2015-11-18 17:34:33 +01:00
end do
end subroutine ic_gb
2015-11-23 18:55:27 +01:00
2024-08-14 10:47:39 +02:00
subroutine rkstep ( params , plasma , sox , bres , xgcn , y , yp , dgr , ddgr , igrad )
2024-07-07 13:18:55 +02:00
! Runge-Kutta integrator
use gray_params , only : gray_parameters
2024-08-14 10:47:39 +02:00
use gray_plasma , only : abstract_plasma
2024-07-07 13:18:55 +02:00
! subroutine arguments
2024-08-14 10:47:39 +02:00
type ( gray_parameters ) , intent ( in ) :: params
class ( abstract_plasma ) , intent ( in ) :: plasma
real ( wp_ ) , intent ( in ) :: bres , xgcn
real ( wp_ ) , intent ( inout ) :: y ( 6 )
real ( wp_ ) , intent ( in ) :: yp ( 6 )
real ( wp_ ) , intent ( in ) :: dgr ( 3 )
real ( wp_ ) , intent ( in ) :: ddgr ( 3 , 3 )
integer , intent ( in ) :: igrad , sox
2015-11-18 17:34:33 +01:00
2024-07-07 13:18:55 +02:00
! local variables
real ( wp_ ) , dimension ( 6 ) :: k1 , k2 , k3 , k4
associate ( h = > params % raytracing % dst )
k1 = yp
k2 = f ( y + k1 * h / 2 )
k3 = f ( y + k2 * h / 2 )
k4 = f ( y + k3 * h )
y = y + h * ( k1 / 6 + k2 / 3 + k3 / 3 + k4 / 6 )
end associate
2015-11-18 17:34:33 +01:00
2024-07-07 13:18:55 +02:00
contains
2015-11-18 17:34:33 +01:00
2024-07-07 13:18:55 +02:00
function f ( y )
real ( wp_ ) , intent ( in ) :: y ( 6 )
real ( wp_ ) :: f ( 6 )
2024-08-14 10:47:39 +02:00
call rhs ( params , plasma , sox , bres , xgcn , y , dgr , ddgr , f , igrad )
2024-07-07 13:18:55 +02:00
end function
2015-11-18 17:34:33 +01:00
end subroutine rkstep
2015-11-23 18:55:27 +01:00
2024-08-14 10:47:39 +02:00
subroutine rhs ( params , plasma , sox , bres , xgcn , y , dgr , ddgr , dery , igrad )
2024-07-07 13:18:55 +02:00
! Compute right-hand side terms of the ray equations (dery)
! used in R-K integrator
use gray_params , only : gray_parameters
2024-08-14 10:47:39 +02:00
use gray_plasma , only : abstract_plasma
2015-11-23 18:55:27 +01:00
2024-07-07 13:18:55 +02:00
! subroutine arguments
type ( gray_parameters ) , intent ( in ) :: params
2024-08-14 10:47:39 +02:00
class ( abstract_plasma ) , intent ( in ) :: plasma
2024-07-07 13:18:55 +02:00
real ( wp_ ) , intent ( in ) :: y ( 6 )
real ( wp_ ) , intent ( in ) :: bres , xgcn
real ( wp_ ) , intent ( in ) :: dgr ( 3 )
real ( wp_ ) , intent ( in ) :: ddgr ( 3 , 3 )
real ( wp_ ) , intent ( out ) :: dery ( 6 )
integer , intent ( in ) :: igrad , sox
! local variables
2023-09-21 13:59:21 +02:00
real ( wp_ ) :: dens , btot , xg , yg
2015-11-18 17:34:33 +01:00
real ( wp_ ) , dimension ( 3 ) :: xv , anv , bv , derxg , deryg
real ( wp_ ) , dimension ( 3 , 3 ) :: derbv
xv = y ( 1 : 3 )
2024-08-14 10:47:39 +02:00
call plas_deriv ( params , plasma , xv , bres , xgcn , dens , btot , &
2024-07-07 13:18:55 +02:00
bv , derbv , xg , yg , derxg , deryg )
2015-11-18 17:34:33 +01:00
anv = y ( 4 : 6 )
2024-07-07 13:18:55 +02:00
call disp_deriv ( params , anv , sox , xg , yg , derxg , deryg , &
bv , derbv , dgr , ddgr , igrad , dery )
2015-11-18 17:34:33 +01:00
end subroutine rhs
2024-08-14 10:47:39 +02:00
subroutine ywppla_upd ( params , plasma , xv , anv , dgr , ddgr , sox , bres , xgcn , dery , &
2024-07-07 13:18:55 +02:00
psinv , dens , btot , bv , xg , yg , derxg , anpl , anpr , &
ddr , ddi , dersdst , derdnm , error , igrad )
! Compute right-hand side terms of the ray equations (dery)
! used after full R-K step and grad(S_I) update
2022-07-14 00:38:34 +02:00
use gray_errors , only : raise_error , large_npl
2024-07-07 13:18:55 +02:00
use gray_params , only : gray_parameters
2024-08-14 10:47:39 +02:00
use gray_plasma , only : abstract_plasma
2024-07-07 13:18:55 +02:00
! subroutine rguments
type ( gray_parameters ) , intent ( in ) :: params
2024-08-14 10:47:39 +02:00
class ( abstract_plasma ) , intent ( in ) :: plasma
2024-07-07 13:18:55 +02:00
real ( wp_ ) , intent ( in ) :: xv ( 3 ) , anv ( 3 )
real ( wp_ ) , intent ( in ) :: dgr ( 3 )
real ( wp_ ) , intent ( in ) :: ddgr ( 3 , 3 )
integer , intent ( in ) :: sox
real ( wp_ ) , intent ( in ) :: bres , xgcn
real ( wp_ ) , intent ( out ) :: dery ( 6 )
real ( wp_ ) , intent ( out ) :: psinv , dens , btot , xg , yg , anpl , anpr
real ( wp_ ) , intent ( out ) :: ddr , ddi , dersdst , derdnm
real ( wp_ ) , intent ( out ) :: bv ( 3 )
integer , intent ( out ) :: error
real ( wp_ ) , intent ( out ) :: derxg ( 3 )
integer , intent ( in ) :: igrad
! local variables
2023-03-29 22:13:43 +02:00
real ( wp_ ) , dimension ( 3 ) :: deryg
2015-11-18 17:34:33 +01:00
real ( wp_ ) , dimension ( 3 , 3 ) :: derbv
2015-11-19 19:20:58 +01:00
real ( wp_ ) , parameter :: anplth1 = 0.99_wp_ , anplth2 = 1.05_wp_
2015-11-18 17:34:33 +01:00
2024-08-14 10:47:39 +02:00
call plas_deriv ( params , plasma , xv , bres , xgcn , dens , btot , bv , derbv , xg , yg , derxg , deryg , psinv )
2024-07-07 13:18:55 +02:00
call disp_deriv ( params , anv , sox , xg , yg , derxg , deryg , bv , derbv , dgr , ddgr , igrad , &
2023-03-29 22:13:43 +02:00
dery , anpl , anpr , ddr , ddi , dersdst , derdnm )
2015-11-19 19:20:58 +01:00
2022-07-14 00:38:34 +02:00
if ( abs ( anpl ) > anplth2 ) then
error = raise_error ( error , large_npl , 1 )
else if ( abs ( anpl ) > anplth1 ) then
error = raise_error ( error , large_npl , 0 )
else
error = 0
2015-11-19 19:20:58 +01:00
end if
2015-11-18 17:34:33 +01:00
end subroutine ywppla_upd
2024-07-07 13:18:55 +02:00
subroutine gradi_upd ( params , ywrk , ak0 , xc , du1 , gri , ggri )
use const_and_precisions , only : zero , half
use gray_params , only : raytracing_parameters
2015-11-23 18:55:27 +01:00
2024-07-07 13:18:55 +02:00
! subroutine parameters
type ( raytracing_parameters ) , intent ( in ) :: params
real ( wp_ ) , intent ( in ) :: ak0
real ( wp_ ) , dimension ( 6 , params % nray ) , intent ( in ) :: ywrk
real ( wp_ ) , dimension ( 3 , params % nrayth , params % nrayr ) , intent ( inout ) :: xc , du1
real ( wp_ ) , dimension ( 3 , params % nray ) , intent ( out ) :: gri
real ( wp_ ) , dimension ( 3 , 3 , params % nray ) , intent ( out ) :: ggri
! local variables
real ( wp_ ) , dimension ( 3 , params % nrayth , params % nrayr ) :: xco , du1o
integer :: jk , j , jm , jp , k , km , kp
real ( wp_ ) :: ux , uxx , uxy , uxz , uy , uyy , uyz , uz , uzz
real ( wp_ ) :: dr , dfuu , dffiu , gx , gxx , gxy , gxz , gy , gyy , gyz , gz , gzz
real ( wp_ ) , dimension ( 3 ) :: dxv1 , dxv2 , dxv3 , dgu
real ( wp_ ) , dimension ( 3 , 3 ) :: dgg , dff
! update position and du1 vectors
2015-11-18 17:34:33 +01:00
xco = xc
du1o = du1
jk = 1
2024-07-07 13:18:55 +02:00
do j = 1 , params % nrayr
do k = 1 , params % nrayth
2015-11-18 17:34:33 +01:00
if ( j > 1 ) jk = jk + 1
xc ( 1 : 3 , k , j ) = ywrk ( 1 : 3 , jk )
end do
end do
2024-07-07 13:18:55 +02:00
! compute grad u1 for central ray
2015-11-18 17:34:33 +01:00
j = 1
jp = 2
2024-07-07 13:18:55 +02:00
do k = 1 , params % nrayth
2015-11-18 17:34:33 +01:00
if ( k == 1 ) then
2024-07-07 13:18:55 +02:00
km = params % nrayth
2015-11-18 17:34:33 +01:00
else
km = k - 1
end if
2024-07-07 13:18:55 +02:00
if ( k == params % nrayth ) then
2015-11-18 17:34:33 +01:00
kp = 1
else
kp = k + 1
end if
dxv1 = xc ( : , k , jp ) - xc ( : , k , j )
dxv2 = xc ( : , kp , jp ) - xc ( : , km , jp )
dxv3 = xc ( : , k , j ) - xco ( : , k , j )
call solg0 ( dxv1 , dxv2 , dxv3 , dgu )
du1 ( : , k , j ) = dgu
end do
gri ( : , 1 ) = zero
2022-05-10 12:36:37 +02:00
2024-07-07 13:18:55 +02:00
! compute grad u1 and grad(S_I) for all the other rays
if ( params % nrayr > 1 ) then
dr = params % rwmax / ( params % nrayr - 1 )
else
dr = 1
end if
dfuu = 2 * dr ** 2 / ak0
2015-11-18 17:34:33 +01:00
jm = 1
j = 2
k = 0
dffiu = dfuu
2024-07-07 13:18:55 +02:00
do jk = 2 , params % nray
2015-11-18 17:34:33 +01:00
k = k + 1
2024-07-07 13:18:55 +02:00
if ( k > params % nrayth ) then
2015-11-18 17:34:33 +01:00
jm = j
j = j + 1
k = 1
dffiu = dfuu * jm
end if
kp = k + 1
km = k - 1
if ( k == 1 ) then
2024-07-07 13:18:55 +02:00
km = params % nrayth
else if ( k == params % nrayth ) then
2015-11-18 17:34:33 +01:00
kp = 1
end if
dxv1 = xc ( : , k , j ) - xc ( : , k , jm )
dxv2 = xc ( : , kp , j ) - xc ( : , km , j )
dxv3 = xc ( : , k , j ) - xco ( : , k , j )
call solg0 ( dxv1 , dxv2 , dxv3 , dgu )
du1 ( : , k , j ) = dgu
gri ( : , jk ) = dgu ( : ) * dffiu
end do
2024-07-07 13:18:55 +02:00
! compute derivatives of grad u and grad(S_I) for rays jk>1
2015-11-18 17:34:33 +01:00
ggri ( : , : , 1 ) = zero
jm = 1
j = 2
k = 0
dffiu = dfuu
2024-07-07 13:18:55 +02:00
do jk = 2 , params % nray
2015-11-18 17:34:33 +01:00
k = k + 1
2024-07-07 13:18:55 +02:00
if ( k > params % nrayth ) then
2015-11-18 17:34:33 +01:00
jm = j
j = j + 1
k = 1
dffiu = dfuu * jm
end if
kp = k + 1
km = k - 1
if ( k == 1 ) then
2024-07-07 13:18:55 +02:00
km = params % nrayth
else if ( k == params % nrayth ) then
2015-11-18 17:34:33 +01:00
kp = 1
end if
dxv1 = xc ( : , k , j ) - xc ( : , k , jm )
dxv2 = xc ( : , kp , j ) - xc ( : , km , j )
dxv3 = xc ( : , k , j ) - xco ( : , k , j )
dff ( : , 1 ) = du1 ( : , k , j ) - du1 ( : , k , jm )
dff ( : , 2 ) = du1 ( : , kp , j ) - du1 ( : , km , j )
dff ( : , 3 ) = du1 ( : , k , j ) - du1o ( : , k , j )
call solg3 ( dxv1 , dxv2 , dxv3 , dff , dgg )
2024-07-07 13:18:55 +02:00
! derivatives of u
2015-11-18 17:34:33 +01:00
ux = du1 ( 1 , k , j )
uy = du1 ( 2 , k , j )
uz = du1 ( 3 , k , j )
uxx = dgg ( 1 , 1 )
uyy = dgg ( 2 , 2 )
uzz = dgg ( 3 , 3 )
uxy = ( dgg ( 1 , 2 ) + dgg ( 2 , 1 ) ) * half
uxz = ( dgg ( 1 , 3 ) + dgg ( 3 , 1 ) ) * half
uyz = ( dgg ( 2 , 3 ) + dgg ( 3 , 2 ) ) * half
2024-07-07 13:18:55 +02:00
! derivatives of S_I and Grad(S_I)
2015-11-18 17:34:33 +01:00
gx = ux * dffiu
gy = uy * dffiu
gz = uz * dffiu
gxx = dfuu * ux * ux + dffiu * uxx
gyy = dfuu * uy * uy + dffiu * uyy
gzz = dfuu * uz * uz + dffiu * uzz
gxy = dfuu * ux * uy + dffiu * uxy
gxz = dfuu * ux * uz + dffiu * uxz
gyz = dfuu * uy * uz + dffiu * uyz
ggri ( 1 , 1 , jk ) = gxx
ggri ( 2 , 1 , jk ) = gxy
ggri ( 3 , 1 , jk ) = gxz
ggri ( 1 , 2 , jk ) = gxy
ggri ( 2 , 2 , jk ) = gyy
ggri ( 3 , 2 , jk ) = gyz
ggri ( 1 , 3 , jk ) = gxz
ggri ( 2 , 3 , jk ) = gyz
ggri ( 3 , 3 , jk ) = gzz
end do
2022-05-10 12:36:37 +02:00
2015-11-18 17:34:33 +01:00
end subroutine gradi_upd
2015-11-23 18:55:27 +01:00
2015-11-18 17:34:33 +01:00
subroutine solg0 ( dxv1 , dxv2 , dxv3 , dgg )
! solution of the linear system of 3 eqs : dgg . dxv = dff
! input vectors : dxv1, dxv2, dxv3, dff
! output vector : dgg
! dff=(1,0,0)
! arguments
real ( wp_ ) , dimension ( 3 ) , intent ( in ) :: dxv1 , dxv2 , dxv3
real ( wp_ ) , dimension ( 3 ) , intent ( out ) :: dgg
! local variables
real ( wp_ ) :: denom , aa1 , aa2 , aa3
aa1 = ( dxv2 ( 2 ) * dxv3 ( 3 ) - dxv3 ( 2 ) * dxv2 ( 3 ) )
aa2 = ( dxv1 ( 2 ) * dxv3 ( 3 ) - dxv3 ( 2 ) * dxv1 ( 3 ) )
aa3 = ( dxv1 ( 2 ) * dxv2 ( 3 ) - dxv2 ( 2 ) * dxv1 ( 3 ) )
denom = dxv1 ( 1 ) * aa1 - dxv2 ( 1 ) * aa2 + dxv3 ( 1 ) * aa3
dgg ( 1 ) = aa1 / denom
dgg ( 2 ) = - ( dxv2 ( 1 ) * dxv3 ( 3 ) - dxv3 ( 1 ) * dxv2 ( 3 ) ) / denom
dgg ( 3 ) = ( dxv2 ( 1 ) * dxv3 ( 2 ) - dxv3 ( 1 ) * dxv2 ( 2 ) ) / denom
end subroutine solg0
subroutine solg3 ( dxv1 , dxv2 , dxv3 , dff , dgg )
! rhs "matrix" dff, result in dgg
! arguments
real ( wp_ ) , dimension ( 3 ) , intent ( in ) :: dxv1 , dxv2 , dxv3
real ( wp_ ) , dimension ( 3 , 3 ) , intent ( in ) :: dff
real ( wp_ ) , dimension ( 3 , 3 ) , intent ( out ) :: dgg
! local variables
real ( wp_ ) denom , a11 , a21 , a31 , a12 , a22 , a32 , a13 , a23 , a33
a11 = ( dxv2 ( 2 ) * dxv3 ( 3 ) - dxv3 ( 2 ) * dxv2 ( 3 ) )
a21 = ( dxv1 ( 2 ) * dxv3 ( 3 ) - dxv3 ( 2 ) * dxv1 ( 3 ) )
a31 = ( dxv1 ( 2 ) * dxv2 ( 3 ) - dxv2 ( 2 ) * dxv1 ( 3 ) )
a12 = ( dxv2 ( 1 ) * dxv3 ( 3 ) - dxv3 ( 1 ) * dxv2 ( 3 ) )
a22 = ( dxv1 ( 1 ) * dxv3 ( 3 ) - dxv3 ( 1 ) * dxv1 ( 3 ) )
a32 = ( dxv1 ( 1 ) * dxv2 ( 3 ) - dxv2 ( 1 ) * dxv1 ( 3 ) )
a13 = ( dxv2 ( 1 ) * dxv3 ( 2 ) - dxv3 ( 1 ) * dxv2 ( 2 ) )
a23 = ( dxv1 ( 1 ) * dxv3 ( 2 ) - dxv3 ( 1 ) * dxv1 ( 2 ) )
a33 = ( dxv1 ( 1 ) * dxv2 ( 2 ) - dxv2 ( 1 ) * dxv1 ( 2 ) )
denom = dxv1 ( 1 ) * a11 - dxv2 ( 1 ) * a21 + dxv3 ( 1 ) * a31
dgg ( : , 1 ) = ( dff ( : , 1 ) * a11 - dff ( : , 2 ) * a21 + dff ( : , 3 ) * a31 ) / denom
dgg ( : , 2 ) = ( - dff ( : , 1 ) * a12 + dff ( : , 2 ) * a22 - dff ( : , 3 ) * a32 ) / denom
dgg ( : , 3 ) = ( dff ( : , 1 ) * a13 - dff ( : , 2 ) * a23 + dff ( : , 3 ) * a33 ) / denom
end subroutine solg3
2024-08-14 10:47:39 +02:00
subroutine plas_deriv ( params , plasma , xv , bres , xgcn , dens , btot , bv , &
2024-07-07 13:18:55 +02:00
derbv , xg , yg , derxg , deryg , psinv_opt )
2023-10-16 11:40:10 +02:00
use const_and_precisions , only : zero , cm
2024-07-07 13:18:55 +02:00
use gray_params , only : gray_parameters , EQ_VACUUM
2024-08-14 10:47:39 +02:00
use gray_plasma , only : abstract_plasma
2024-07-07 13:18:55 +02:00
use equilibrium , only : psia , pol_flux , pol_curr , sgnbphi
2022-05-10 12:36:37 +02:00
! subroutine arguments
2024-07-07 13:18:55 +02:00
type ( gray_parameters ) , intent ( in ) :: params
2024-08-14 10:47:39 +02:00
class ( abstract_plasma ) , intent ( in ) :: plasma
2023-03-29 22:13:43 +02:00
real ( wp_ ) , dimension ( 3 ) , intent ( in ) :: xv
real ( wp_ ) , intent ( in ) :: xgcn , bres
real ( wp_ ) , intent ( out ) :: dens , btot , xg , yg
real ( wp_ ) , dimension ( 3 ) , intent ( out ) :: bv , derxg , deryg
2015-11-18 17:34:33 +01:00
real ( wp_ ) , dimension ( 3 , 3 ) , intent ( out ) :: derbv
2023-03-29 22:13:43 +02:00
real ( wp_ ) , optional , intent ( out ) :: psinv_opt
2022-05-10 12:36:37 +02:00
! local variables
2015-11-18 17:34:33 +01:00
integer :: jv
2023-03-29 22:13:43 +02:00
real ( wp_ ) :: xx , yy , zz
real ( wp_ ) :: psinv
2022-05-06 00:31:18 +02:00
real ( wp_ ) :: csphi , drrdx , drrdy , dphidx , dphidy , rr , rr2 , rrm , snphi , zzm
2015-11-18 17:34:33 +01:00
real ( wp_ ) , dimension ( 3 ) :: dbtot , bvc
real ( wp_ ) , dimension ( 3 , 3 ) :: dbvcdc , dbvdc , dbv
2023-03-29 22:13:43 +02:00
real ( wp_ ) :: brr , bphi , bzz , dxgdpsi
2023-10-16 11:40:10 +02:00
real ( wp_ ) :: dpsidr , dpsidz , ddpsidrr , ddpsidzz , ddpsidrz , fpolv , dfpv , ddensdpsi
2015-11-18 17:34:33 +01:00
xg = zero
yg = 9 9._wp_
psinv = - 1._wp_
dens = zero
btot = zero
derxg = zero
deryg = zero
bv = zero
derbv = zero
2024-07-07 13:18:55 +02:00
if ( params % equilibrium % iequil == EQ_VACUUM ) then
2023-03-29 22:13:43 +02:00
! copy optional output
if ( present ( psinv_opt ) ) psinv_opt = psinv
return
end if
2015-11-18 17:34:33 +01:00
dbtot = zero
dbv = zero
dbvcdc = zero
dbvcdc = zero
dbvdc = zero
xx = xv ( 1 )
yy = xv ( 2 )
zz = xv ( 3 )
2022-05-10 12:36:37 +02:00
! cylindrical coordinates
2015-11-18 17:34:33 +01:00
rr2 = xx ** 2 + yy ** 2
rr = sqrt ( rr2 )
csphi = xx / rr
snphi = yy / rr
bv ( 1 ) = - snphi * sgnbphi
bv ( 2 ) = csphi * sgnbphi
2022-05-10 12:36:37 +02:00
! convert from cm to meters
2015-11-18 17:34:33 +01:00
zzm = 1.0e-2_wp_ * zz
rrm = 1.0e-2_wp_ * rr
2023-10-22 10:32:27 +02:00
call pol_flux ( rrm , zzm , psinv , dpsidr , dpsidz , ddpsidrr , ddpsidzz , ddpsidrz )
call pol_curr ( psinv , fpolv , dfpv )
2015-11-18 17:34:33 +01:00
2023-03-29 22:13:43 +02:00
! copy optional output
if ( present ( psinv_opt ) ) psinv_opt = psinv
2022-05-10 12:36:37 +02:00
! compute yg and derivative
2015-11-18 17:34:33 +01:00
if ( psinv < zero ) then
bphi = fpolv / rrm
btot = abs ( bphi )
yg = btot / bres
return
end if
2022-05-10 12:36:37 +02:00
! compute xg and derivative
2024-08-14 10:47:39 +02:00
call plasma % density ( psinv , dens , ddensdpsi )
2015-11-18 17:34:33 +01:00
xg = xgcn * dens
2023-10-16 11:40:10 +02:00
dxgdpsi = xgcn * ddensdpsi
2022-05-10 12:36:37 +02:00
! B = f(psi)/R e_phi+ grad psi x e_phi/R
2023-10-16 11:40:10 +02:00
bphi = fpolv / rrm
brr = - dpsidz * psia / rrm
bzz = + dpsidr * psia / rrm
2015-11-18 17:34:33 +01:00
2022-05-10 12:36:37 +02:00
! bvc(i) = B_i in cylindrical coordinates
bvc = [ brr , bphi , bzz ]
2015-11-18 17:34:33 +01:00
2022-05-10 12:36:37 +02:00
! bv(i) = B_i in cartesian coordinates
2015-11-18 17:34:33 +01:00
bv ( 1 ) = bvc ( 1 ) * csphi - bvc ( 2 ) * snphi
bv ( 2 ) = bvc ( 1 ) * snphi + bvc ( 2 ) * csphi
bv ( 3 ) = bvc ( 3 )
2022-05-10 12:36:37 +02:00
! dbvcdc(iv,jv) = d Bcil(iv) / dxvcil(jv)
2023-10-27 00:58:34 +02:00
dbvcdc ( 1 , 1 ) = - ddpsidrz * psia / rrm - brr / rrm
dbvcdc ( 1 , 3 ) = - ddpsidzz * psia / rrm
dbvcdc ( 2 , 1 ) = dfpv * dpsidr / rrm - bphi / rrm
dbvcdc ( 2 , 3 ) = dfpv * dpsidz / rrm
dbvcdc ( 3 , 1 ) = + ddpsidrr * psia / rrm - bzz / rrm
dbvcdc ( 3 , 3 ) = + ddpsidrz * psia / rrm
2015-11-18 17:34:33 +01:00
2022-05-10 12:36:37 +02:00
! dbvdc(iv,jv) = d Bcart(iv) / dxvcil(jv)
2015-11-18 17:34:33 +01:00
dbvdc ( 1 , 1 ) = dbvcdc ( 1 , 1 ) * csphi - dbvcdc ( 2 , 1 ) * snphi
dbvdc ( 2 , 1 ) = dbvcdc ( 1 , 1 ) * snphi + dbvcdc ( 2 , 1 ) * csphi
dbvdc ( 3 , 1 ) = dbvcdc ( 3 , 1 )
dbvdc ( 1 , 2 ) = - bv ( 2 )
dbvdc ( 2 , 2 ) = bv ( 1 )
2023-10-04 16:56:05 +02:00
dbvdc ( 3 , 2 ) = dbvcdc ( 3 , 2 ) ! = 0
2015-11-18 17:34:33 +01:00
dbvdc ( 1 , 3 ) = dbvcdc ( 1 , 3 ) * csphi - dbvcdc ( 2 , 3 ) * snphi
dbvdc ( 2 , 3 ) = dbvcdc ( 1 , 3 ) * snphi + dbvcdc ( 2 , 3 ) * csphi
dbvdc ( 3 , 3 ) = dbvcdc ( 3 , 3 )
drrdx = csphi
drrdy = snphi
dphidx = - snphi / rrm
dphidy = csphi / rrm
2022-05-10 12:36:37 +02:00
! dbv(iv,jv) = d Bcart(iv) / dxvcart(jv)
2015-11-18 17:34:33 +01:00
dbv ( : , 1 ) = drrdx * dbvdc ( : , 1 ) + dphidx * dbvdc ( : , 2 )
dbv ( : , 2 ) = drrdy * dbvdc ( : , 1 ) + dphidy * dbvdc ( : , 2 )
dbv ( : , 3 ) = dbvdc ( : , 3 )
2022-05-10 12:36:37 +02:00
! B magnitude and derivatives
2022-05-06 00:31:18 +02:00
btot = norm2 ( bv )
2015-11-18 17:34:33 +01:00
2023-10-04 16:56:05 +02:00
! dbtot(i) = d |B| / dxvcart(i)
2022-05-06 00:31:18 +02:00
dbtot = matmul ( bv , dbv ) / btot
2015-11-18 17:34:33 +01:00
yg = btot / Bres
2022-05-10 12:36:37 +02:00
! convert spatial derivatives from dummy/m -> dummy/cm
! to be used in rhs
2015-11-18 17:34:33 +01:00
2022-05-10 12:36:37 +02:00
! bv(i) = B_i / B ; derbv(i,j) = d (B_i / B) /d x,y,z
2015-11-18 17:34:33 +01:00
deryg = 1.0e-2_wp_ * dbtot / Bres
bv = bv / btot
do jv = 1 , 3
2023-10-16 11:40:10 +02:00
derbv ( : , jv ) = cm * ( dbv ( : , jv ) - bv ( : ) * dbtot ( jv ) ) / btot
2015-11-18 17:34:33 +01:00
end do
2023-10-16 11:40:10 +02:00
derxg ( 1 ) = cm * drrdx * dpsidr * dxgdpsi
derxg ( 2 ) = cm * drrdy * dpsidr * dxgdpsi
derxg ( 3 ) = cm * dpsidz * dxgdpsi
2015-11-18 17:34:33 +01:00
end subroutine plas_deriv
2015-11-23 18:55:27 +01:00
2024-07-07 13:18:55 +02:00
subroutine disp_deriv ( params , anv , sox , xg , yg , derxg , deryg , bv , derbv , &
dgr , ddgr , igrad , dery , anpl_ , anpr , ddr , ddi , &
2023-03-29 22:13:43 +02:00
dersdst , derdnm_ )
! Computes the dispersion relation, derivatives and other
! related quantities
!
! The mandatory outputs are used for both integrating the ray
! trajectory (`rhs` subroutine) and updating the ray state
! (`ywppla_upd` suborutine); while the optional ones are used for
! computing the absoprtion and current drive.
2022-05-10 12:36:37 +02:00
use const_and_precisions , only : zero , one , half , two
2024-07-07 13:18:55 +02:00
use gray_params , only : gray_parameters , STEP_ARCLEN , &
STEP_TIME , STEP_PHASE
2022-05-10 12:36:37 +02:00
! subroutine arguments
2023-03-29 22:13:43 +02:00
! Inputs
2024-07-07 13:18:55 +02:00
type ( gray_parameters ) , intent ( in ) :: params
2023-03-29 22:13:43 +02:00
! refractive index N̅ vector, b̅ = B̅/B magnetic field direction
real ( wp_ ) , dimension ( 3 ) , intent ( in ) :: anv , bv
! sign of polarisation mode: -1 ⇒ O, +1 ⇒ X
2022-05-20 13:10:49 +02:00
integer , intent ( in ) :: sox
2023-03-29 22:13:43 +02:00
! CMA diagram variables: X=(ω_pe/ω)², Y=ω_ce/ω
real ( wp_ ) , intent ( in ) :: xg , yg
! gradients of X, Y
real ( wp_ ) , dimension ( 3 ) , intent ( in ) :: derxg , deryg
! gradients of the complex eikonal
real ( wp_ ) , dimension ( 3 ) , intent ( in ) :: dgr ! ∇S_I
real ( wp_ ) , dimension ( 3 , 3 ) , intent ( in ) :: ddgr ! ∇∇S_I
! gradient of the magnetic field direction
real ( wp_ ) , dimension ( 3 , 3 ) , intent ( in ) :: derbv ! ∇b̅
! raytracing/beamtracing switch
integer , intent ( in ) :: igrad
! Outputs
! the actual derivatives: (∂Λ/∂x̅, -∂Λ/∂N̅)
real ( wp_ ) , dimension ( 6 ) , intent ( out ) :: dery
! additional quantities:
! refractive index
real ( wp_ ) , optional , intent ( out ) :: anpl_ , anpr ! N∥, N⊥
! real and imaginary part of the dispersion
real ( wp_ ) , optional , intent ( out ) :: ddr , ddi ! Λ, ∂Λ/∂N̅⋅∇S_I
! Jacobian ds/dσ , where s arclength, σ integration variable
real ( wp_ ) , optional , intent ( out ) :: dersdst
! |∂Λ/∂N̅|
real ( wp_ ) , optional , intent ( out ) :: derdnm_
! Note: assign values to missing optional arguments results in a segfault.
! Since some are always needed anyway, we store them here and copy
! them later, if needed:
real ( wp_ ) :: anpl , derdnm
2022-05-10 12:36:37 +02:00
! local variables
2023-03-29 22:13:43 +02:00
real ( wp_ ) :: gr2 , yg2 , anpl2 , del , dnl , duh , dan2sdnpl , an2 , an2s
real ( wp_ ) :: dan2sdxg , dan2sdyg , denom
2022-05-10 12:36:37 +02:00
real ( wp_ ) :: derdom , dfdiadnpl , dfdiadxg , dfdiadyg , fdia , bdotgr
real ( wp_ ) , dimension ( 3 ) :: derdxv , danpldxv , derdnv , dbgr
2015-11-18 17:34:33 +01:00
2023-03-29 22:13:43 +02:00
an2 = dot_product ( anv , anv ) ! N²
anpl = dot_product ( anv , bv ) ! N∥ = N̅⋅B̅
2015-11-18 17:34:33 +01:00
2023-03-29 22:13:43 +02:00
! Shorthands used in the expressions below
yg2 = yg ** 2 ! Y²
anpl2 = anpl ** 2 ! N∥²
dnl = one - anpl2 ! 1 - N∥²
duh = one - xg - yg2 ! UH denom (duh=0 on the upper-hybrid resonance)
! Compute/copy optional outputs
if ( present ( anpr ) ) anpr = sqrt ( max ( an2 - anpl2 , zero ) ) ! N⊥
if ( present ( anpl_ ) ) anpl_ = anpl ! N∥
2015-11-18 17:34:33 +01:00
an2s = one
dan2sdxg = zero
dan2sdyg = zero
dan2sdnpl = zero
del = zero
fdia = zero
dfdiadnpl = zero
dfdiadxg = zero
dfdiadyg = zero
if ( xg > zero ) then
2023-03-29 22:13:43 +02:00
! Derivatives of the cold plasma refractive index
2022-05-10 12:36:37 +02:00
!
2023-03-29 22:13:43 +02:00
! N²s = 1 - X - XY²⋅(1 + N∥² ± √Δ)/[2(1 - X - Y²)]
2022-05-10 12:36:37 +02:00
!
2023-03-29 22:13:43 +02:00
! where Δ = (1 - N∥²)² + 4N∥²⋅(1 - X)/Y²
! + for the X mode, - for the O mode
! √Δ
del = sqrt ( dnl ** 2 + 4.0_wp_ * anpl2 * ( one - xg ) / yg2 )
2015-11-18 17:34:33 +01:00
2022-05-10 12:36:37 +02:00
! ∂(N²s)/∂X
2023-03-29 11:19:00 +02:00
! Note: this term is nonzero for X=0, but it multiplies terms
! proportional to X or ∂X/∂ψ which are zero outside the plasma.
2015-11-18 17:34:33 +01:00
dan2sdxg = - half * yg2 * ( one - yg2 ) * ( one + anpl2 + sox * del ) / duh ** 2 &
+ sox * xg * anpl2 / ( del * duh ) - one
2022-05-10 12:36:37 +02:00
! ∂(N²s)/∂Y
2015-11-18 17:34:33 +01:00
dan2sdyg = - xg * yg * ( one - xg ) * ( one + anpl2 + sox * del ) / duh ** 2 &
+ two * sox * xg * ( one - xg ) * anpl2 / ( yg * del * duh )
2022-05-10 12:36:37 +02:00
! ∂(N²s)/∂N∥
2015-11-18 17:34:33 +01:00
dan2sdnpl = - xg * yg2 * anpl / duh &
- sox * xg * anpl * ( two * ( one - xg ) - yg2 * dnl ) / ( del * duh )
if ( igrad > 0 ) then
2023-03-29 22:13:43 +02:00
! Derivatives used in the complex eikonal terms (beamtracing only)
block
real ( wp_ ) :: ddelnpl2 , ddelnpl2x , ddelnpl2y , derdel
! ∂²Δ/∂N∥²
ddelnpl2 = two * ( two * ( one - xg ) * ( one + 3.0_wp_ * anpl2 ** 2 ) &
- yg2 * dnl ** 3 ) / yg2 / del ** 3
! ∂²(N²s)/∂N∥²
fdia = - xg * yg2 * ( one + half * sox * ddelnpl2 ) / duh
! Intermediates results used right below
derdel = two * ( one - xg ) * anpl2 * ( one + 3.0_wp_ * anpl2 ** 2 ) &
- dnl ** 2 * ( one + 3.0_wp_ * anpl2 ) * yg2
derdel = 4.0_wp_ * derdel / ( yg * del ) ** 5
ddelnpl2y = two * ( one - xg ) * derdel
ddelnpl2x = yg * derdel
! ∂³(N²s)/∂N∥³
dfdiadnpl = 2 4.0_wp_ * sox * xg * ( one - xg ) * anpl * ( one - anpl2 ** 2 ) &
/ ( yg2 * del ** 5 )
! ∂³(N²s)/∂N∥²∂X
dfdiadxg = - yg2 * ( one - yg2 ) / duh ** 2 - sox * yg2 * ( ( one - yg2 ) &
* ddelnpl2 + xg * duh * ddelnpl2x ) / ( two * duh ** 2 )
! ∂³(N²s)/∂N∥²∂Y
dfdiadyg = - two * yg * xg * ( one - xg ) / duh ** 2 &
- sox * xg * yg * ( two * ( one - xg ) * ddelnpl2 &
+ yg * duh * ddelnpl2y ) / ( two * duh ** 2 )
end block
2015-11-18 17:34:33 +01:00
end if
end if
2023-03-29 22:13:43 +02:00
! ∇(N∥) = ∇(N̅⋅b̅) = N̅⋅∇b̅
2022-05-10 12:36:37 +02:00
danpldxv = matmul ( anv , derbv )
2015-11-18 17:34:33 +01:00
2023-03-29 22:13:43 +02:00
! ∂Λ/∂x̅ = - ∇(N²s) = -∂Λ/∂X ∇X - ∂Λ/∂Y ∇Y - ∂Λ/∂N∥ ∇(N∥)
derdxv = - ( derxg * dan2sdxg + deryg * dan2sdyg + danpldxv * dan2sdnpl )
! ∂Λ/∂N̅ = 2N̅ - ∂(N²s)/∂N̅ = 2N̅ - ∂(N²s)/∂N∥ b̅
! Note: we used the identity ∇f(v̅⋅b̅) = f' ∇(v̅⋅b̅) = f'b̅.
derdnv = two * anv - dan2sdnpl * bv
! ∂Λ/∂ω = ∂N²/∂ω - ∂N²s/∂X⋅∂X/∂ω - ∂N²s/∂Y⋅∂Y/∂ω - ∂N²s/∂N∥⋅∂N∥/∂ω
! Notes: 1. N depends on ω: N²=c²k²/ω² ⇒ ∂N²/∂ω = -2N²/ω
! N∥=ck∥/ω ⇒ ∂N∥/∂ω = -N∥/ω
! 2. derdom is actually ω⋅∂Λ/∂ω, see below for the reason.
! 3. N gains a dependency on ω because Λ(∇S, ω) is computed
! on the constrains Λ=0.
derdom = - two * an2 + two * xg * dan2sdxg + yg * dan2sdyg + anpl * dan2sdnpl
if ( igrad > 0 ) then
! Complex eikonal terms added to the above expressions
block
real ( wp_ ) :: dgr2 ( 3 )
bdotgr = dot_product ( bv , dgr ) ! b̅⋅∇S_I
gr2 = dot_product ( dgr , dgr ) ! |∇S_I|²
dgr2 = 2 * matmul ( ddgr , dgr ) ! ∇|∇S_I|² = 2 ∇∇S_I⋅∇S_I
! ∇(b̅⋅∇S_I) = ∇b̅ᵗ ∇S_I + b̅ᵗ ∇∇S_I
! Notes: 1. We are using the convention ∇b̅_ij = ∂b_i/∂x_j.
! 2. Fortran doesn't distinguish between column/row vectors,
! so matmul(A, v̅) ≅ Av̅ and matmul(v̅, A) ≅ v̅ᵗA ≅ Aᵗv̅.
dbgr = matmul ( dgr , derbv ) + matmul ( bv , ddgr )
! ∂Λ/∂x̅ += - ∇(|∇S_I|²) + ½ ∇[(b̅⋅∇S_I)² ∂²N²s/∂N∥²]
derdxv = derdxv - dgr2 + fdia * bdotgr * dbgr + half * bdotgr ** 2 &
* ( derxg * dfdiadxg + deryg * dfdiadyg + danpldxv * dfdiadnpl )
! ∂Λ/∂N̅ += ½(b̅⋅∇S_I)² ∂³(N²s)/∂N∥³ b̅
! Note: we used again the identity ∇f(v̅⋅b̅) = f'b̅.
derdnv = derdnv + half * bdotgr ** 2 * dfdiadnpl * bv
! ∂Λ/∂ω += ∂|∇S_I|²/∂ω + ½∂(b⋅∇S_I)²/∂ω + ½(b̅⋅∇S_I)² ∂/∂ω (∂²N²s/∂N∥²)
! Note: as above ∇S_I gains a dependency on ω
derdom = derdom + two * gr2 - bdotgr ** 2 &
* ( fdia + xg * dfdiadxg + half * yg * dfdiadyg &
+ half * anpl * dfdiadnpl )
end block
end if
2015-11-18 17:34:33 +01:00
2023-03-29 22:13:43 +02:00
derdnm = norm2 ( derdnv )
! Denominator of the r.h.s, depending on the
! choice of the integration variable σ :
!
! dx̅/dσ = + ∂Λ/∂N̅ / denom
! dN̅/dσ = - ∂Λ/∂x̅ / denom
!
2024-07-07 13:18:55 +02:00
select case ( params % raytracing % idst )
case ( STEP_ARCLEN ) ! σ =s, arclength
2023-03-29 22:13:43 +02:00
! denom = |∂Λ/∂N̅|
! Proof: Normalising ∂Λ/∂N̅ (∥ to the group velocity)
! simply makes σ the arclength parameter s.
2022-05-10 12:36:37 +02:00
denom = derdnm
2024-07-07 13:18:55 +02:00
case ( STEP_TIME ) ! σ =ct, time
2023-03-29 22:13:43 +02:00
! denom = -ω⋅∂Λ/∂ω
! Proof: The Hamilton equations are
!
! dx̅/dt = + ∂H/∂k̅ (H=ℏΩ, p=ℏk̅)
! dp̅/dt = - ∂H/∂x̅
!
! where Ω(x̅, k̅) is implicitely defined by the dispersion
! D(k̅, ω, x̅) = 0. By differentiating the latter we get:
!
! ∂Ω/∂x̅ = - ∂D/∂x̅ / ∂D/∂ω = - ∂Λ/∂x̅ / ∂Λ/∂ω
! ∂Ω/∂k̅ = - ∂D/∂k̅ / ∂D/∂ω = - ∂Λ/∂k̅ / ∂Λ/∂ω
!
! with Λ=D/k₀, k₀=ω/c. Finally, substituting k̅=k₀N̅:
!
! dx̅/d(ct) = + ∂Λ/∂N̅ / (-ω⋅∂Λ/∂ω)
! dN̅/d(ct) = - ∂Λ/∂x̅ / (-ω⋅∂Λ/∂ω)
!
2022-05-10 12:36:37 +02:00
denom = - derdom
2024-07-07 13:18:55 +02:00
case ( STEP_PHASE ) ! s=S_R, phase
2023-03-29 22:13:43 +02:00
! denom = N̅⋅∂Λ/∂N̅
! Note: This parametrises the curve by the value
! of the (real) phase, with the wave frozen in time.
! Proof: By definition N̅ = k̅/k₀ = ∇S. Using the gradient
! theorem on the ray curve parametrised by the arclength
!
! S(s) = ∫₀^x̅(s) N̅⋅dl̅ = ∫₀^s N̅(σ )⋅dx̅/ds ds
!
! Differentiating gives dS = N̅⋅dx̅/ds ds, so
!
! dS = N̅⋅∂Λ/∂N̅ / |∂Λ/∂N̅| ds ⇒
!
! dx̅/dS = + ∂Λ/∂N̅ / N̅⋅∂Λ/∂N̅
! dN̅/dS = - ∂Λ/∂x̅ / N̅⋅∂Λ/∂N̅
!
2022-05-10 12:36:37 +02:00
denom = dot_product ( anv , derdnv )
end select
2015-11-18 17:34:33 +01:00
2023-03-29 22:13:43 +02:00
! Jacobian ds/dσ , where s is the arclength,
! for computing integrals in dσ , like:
!
! τ = ∫α(s)ds = ∫α(σ )(ds/dσ )dσ
!
if ( present ( dersdst ) ) dersdst = derdnm / denom
! |∂Λ/∂N̅|: used in the α computation (see alpha_effj)
if ( present ( derdnm_ ) ) derdnm_ = derdnm
2015-11-18 17:34:33 +01:00
2022-05-10 12:36:37 +02:00
! r.h.s. vector
2023-03-29 22:13:43 +02:00
dery ( 1 : 3 ) = derdnv ( : ) / denom ! +∂Λ/∂N̅
2022-05-10 12:36:37 +02:00
dery ( 4 : 6 ) = - derdxv ( : ) / denom ! -∂Λ/∂x̅
2015-11-18 17:34:33 +01:00
2023-03-29 22:13:43 +02:00
if ( present ( ddr ) . or . present ( ddi ) ) then
! Dispersion relation (geometric optics)
! ddr ← Λ = N² - N²s(X,Y,N∥) = 0
an2s = one - xg - half * xg * yg2 * ( one + anpl2 + sox * del ) / duh
ddr = an2 - an2s
end if
if ( present ( ddr ) . and . igrad > 0 ) then
! Dispersion relation (complex eikonal)
! ddr ← Λ = N² - N²s - |∇S_I|² + ½ (b̅⋅∇S_I)² ∂²N²s/∂N∥²
ddr = ddr - gr2 - half * bdotgr ** 2 * fdia ! real part
end if
! Note: we have to return ddi even for igrad=0 because
! it's printed to udisp unconditionally
if ( present ( ddi ) ) then
! Dispersion relation (complex eikonal)
! ddi ← ∂Λ/∂N̅⋅∇S_I
ddi = merge ( dot_product ( derdnv , dgr ) , zero , igrad > 0 ) ! imaginary part
end if
2015-11-18 17:34:33 +01:00
end subroutine disp_deriv
2015-11-23 18:55:27 +01:00
2024-08-14 10:47:39 +02:00
subroutine alpha_effj ( params , plasma , psinv , X , Y , density , temperature , &
k0 , Bres , derdnm , Npl , Npr_cold , sox , Npr , &
alpha , dIdp , nhmin , nhmax , iokhawa , error )
2022-05-10 12:36:37 +02:00
! Computes the absorption coefficient and effective current
2022-05-20 13:10:49 +02:00
use const_and_precisions , only : pi , mc2 = > mc2_
2022-05-10 12:36:37 +02:00
use gray_params , only : ecrh_cd_parameters
2024-08-14 10:47:39 +02:00
use gray_plasma , only : abstract_plasma
2022-05-10 12:36:37 +02:00
use equilibrium , only : sgnbphi
use dispersion , only : harmnumber , warmdisp
use eccd , only : setcdcoeff , eccdeff , fjch0 , fjch , fjncl
2022-07-14 00:38:34 +02:00
use gray_errors , only : negative_absorption , raise_error
2022-05-10 12:36:37 +02:00
use magsurf_data , only : fluxval
2015-11-18 17:34:33 +01:00
2022-05-10 12:36:37 +02:00
! subroutine arguments
! Inputs
! ECRH & CD parameters
2024-08-14 10:47:39 +02:00
type ( ecrh_cd_parameters ) , intent ( in ) :: params
! plasma object
class ( abstract_plasma ) , intent ( in ) :: plasma
2022-05-10 12:36:37 +02:00
! poloidal flux ψ
real ( wp_ ) , intent ( in ) :: psinv
! CMA diagram variables: X=(ω_pe/ω)², Y=ω_ce/ω
2022-05-20 13:10:49 +02:00
real ( wp_ ) , intent ( in ) :: X , Y
! densityity [10¹⁹ m⁻³], temperature [keV]
real ( wp_ ) , intent ( in ) :: density , temperature
2022-05-10 12:36:37 +02:00
! vacuum wavenumber k₀=ω/c, resonant B field
2022-05-20 13:10:49 +02:00
real ( wp_ ) , intent ( in ) :: k0 , Bres
2022-05-10 12:36:37 +02:00
! group velocity: |∂Λ/∂N̅| where Λ=c²/ω²⋅D_R
real ( wp_ ) , intent ( in ) :: derdnm
! refractive index: N∥, N⊥ (cold dispersion)
2022-05-20 13:10:49 +02:00
real ( wp_ ) , intent ( in ) :: Npl , Npr_cold
2022-05-10 12:36:37 +02:00
! sign of polarisation mode: -1 ⇒ O, +1 ⇒ X
2022-05-20 13:10:49 +02:00
integer , intent ( in ) :: sox
2022-05-10 12:36:37 +02:00
! Outputs
2022-05-20 13:10:49 +02:00
! orthogonal refractive index N⊥ (solution of the warm dispersion)
complex ( wp_ ) , intent ( out ) :: Npr
2022-05-10 12:36:37 +02:00
! absorption coefficient, current density
2022-05-20 13:10:49 +02:00
real ( wp_ ) , intent ( out ) :: alpha , dIdp
2022-05-10 12:36:37 +02:00
! lowest/highest resonant harmonic numbers
integer , intent ( out ) :: nhmin , nhmax
! ECCD/overall error codes
integer , intent ( out ) :: iokhawa , error
! local variables
real ( wp_ ) :: rbavi , rrii , rhop
2022-05-20 13:10:49 +02:00
integer :: nlarmor , ithn , ierrcd
real ( wp_ ) :: mu , rbn , rbx
2022-05-10 12:36:37 +02:00
real ( wp_ ) :: zeff , cst2 , bmxi , bmni , fci
2024-04-23 17:00:40 +02:00
real ( wp_ ) , dimension ( : ) , allocatable :: eccdpar
2022-05-20 13:10:49 +02:00
real ( wp_ ) :: effjcd , effjcdav , Btot
complex ( wp_ ) :: e ( 3 )
alpha = 0
Npr = 0
dIdp = 0
2022-05-10 12:36:37 +02:00
nhmin = 0
nhmax = 0
iokhawa = 0
error = 0
! Absorption computation
! Skip when the temperature is zero (no plasma)
2022-05-20 13:10:49 +02:00
if ( temperature < = 0 ) return
2022-05-10 12:36:37 +02:00
! Skip when the lowest resonant harmonic number is zero
2022-05-20 13:10:49 +02:00
mu = mc2 / temperature ! μ=(mc²/kT)
call harmnumber ( Y , mu , Npl ** 2 , params % iwarm == 1 , nhmin , nhmax )
2022-05-10 12:36:37 +02:00
if ( nhmin < = 0 ) return
2022-05-20 13:10:49 +02:00
! Solve the full dispersion only when needed
if ( params % iwarm / = 4 . or . params % ieccd / = 0 ) then
nlarmor = max ( params % ilarm , nhmax )
if ( params % ieccd / = 0 ) then
! Compute the polarisation vector only when current drive is on
call warmdisp ( X , Y , mu , Npl , Npr_cold , sox , error , Npr , e , &
model = params % iwarm , nlarmor = nlarmor , &
max_iters = abs ( params % imx ) , fallback = params % imx < 0 )
else
call warmdisp ( X , Y , mu , Npl , Npr_cold , sox , error , Npr , &
model = params % iwarm , nlarmor = nlarmor , &
max_iters = abs ( params % imx ) , fallback = params % imx < 0 )
end if
end if
2022-05-10 12:36:37 +02:00
2022-05-20 13:10:49 +02:00
! Compute α from the solution of the dispersion relation
2022-05-10 12:36:37 +02:00
! The absoption coefficient is defined as
!
! α = 2 Im(k̅)⋅s̅
!
! where s̅ = v̅_g/|v_g|, the direction of the energy flow.
2022-05-20 13:10:49 +02:00
! Since v̅_g = - ∂Λ/∂N̅ / ∂Λ/∂ω, using the cold dispersion
! relation, we have that
2022-05-10 12:36:37 +02:00
!
! s̅ = ∂Λ/∂N̅ / |∂Λ/∂N̅|
2022-05-20 13:10:49 +02:00
! = [2N̅ - ∂(N²s)/∂N∥ b̅
! + ½(b̅⋅∇S_I)² ∂³(N²s)/∂N∥³ b̅] / |∂Λ/∂N̅|
2022-05-10 12:36:37 +02:00
!
! Assuming Im(k∥)=0:
!
! α = 4 Im(k⊥)⋅N⊥ / |∂Λ/∂N̅|
!
2022-05-20 13:10:49 +02:00
block
real ( wp_ ) :: k_im
k_im = k0 * Npr % im ! imaginary part of k⊥
alpha = 4 * k_im * Npr_cold / derdnm
end block
2022-05-10 12:36:37 +02:00
2022-05-20 13:10:49 +02:00
if ( alpha < 0 ) then
2022-07-14 00:38:34 +02:00
error = raise_error ( error , negative_absorption )
2022-05-10 12:36:37 +02:00
return
2015-11-18 17:34:33 +01:00
end if
2022-05-10 12:36:37 +02:00
! Current drive computation
if ( params % ieccd < = 0 ) return
2024-08-14 10:47:39 +02:00
zeff = plasma % zeff ( psinv )
2022-05-10 12:36:37 +02:00
ithn = 1
2022-05-20 13:10:49 +02:00
if ( nlarmor > nhmin ) ithn = 2
2022-05-10 12:36:37 +02:00
rhop = sqrt ( psinv )
call fluxval ( rhop , rri = rrii , rbav = rbavi , bmn = bmni , bmx = bmxi , fc = fci )
2022-05-20 13:10:49 +02:00
Btot = Y * Bres
rbn = Btot / bmni
rbx = Btot / bmxi
2022-05-10 12:36:37 +02:00
select case ( params % ieccd )
case ( 1 )
! Cohen model
2022-05-20 13:10:49 +02:00
call setcdcoeff ( zeff , rbn , rbx , cst2 , eccdpar )
call eccdeff ( Y , Npl , Npr % re , density , mu , e , nhmin , nhmax , &
ithn , cst2 , fjch , eccdpar , effjcd , iokhawa , ierrcd )
2022-05-10 12:36:37 +02:00
case ( 2 )
! No trapping
2022-05-20 13:10:49 +02:00
call setcdcoeff ( zeff , cst2 , eccdpar )
call eccdeff ( Y , Npl , Npr % re , density , mu , e , nhmin , nhmax , &
ithn , cst2 , fjch0 , eccdpar , effjcd , iokhawa , ierrcd )
2022-05-10 12:36:37 +02:00
case default
! Neoclassical model
2022-05-20 13:10:49 +02:00
call setcdcoeff ( zeff , rbx , fci , mu , rhop , cst2 , eccdpar )
call eccdeff ( Y , Npl , Npr % re , density , mu , e , nhmin , nhmax , &
ithn , cst2 , fjncl , eccdpar , effjcd , iokhawa , ierrcd )
2022-05-10 12:36:37 +02:00
end select
error = error + ierrcd
2024-04-23 17:00:40 +02:00
if ( allocated ( eccdpar ) ) deallocate ( eccdpar )
2022-05-10 12:36:37 +02:00
! current drive efficiency <j/p> [A⋅m/W]
effjcdav = rbavi * effjcd
2022-05-20 13:10:49 +02:00
dIdp = sgnbphi * effjcdav / ( 2 * pi * rrii )
2022-05-10 12:36:37 +02:00
2015-11-18 17:34:33 +01:00
end subroutine alpha_effj
2021-12-15 02:31:14 +01:00
end module gray_core