istp/gray
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases 1 Wiki Activity

src/dispersion.f90: cleanup

Browse Source 
- merge branch with a method to control the speed of iteration and
  improve the convergence of `warmdisp` (thanks Thomas)

- unify `diel_tens_fr` and `diel_tens_wr` into a single subroutine,
  `dielectric_tensor`

- stay as close as possible to the notation of Daniela Farina's paper

- make `sox` an integer

- mark more subroutines as pure

- add more comments
This commit is contained in:
Michele Guerini Rocco 2022-05-20 13:10:49 +02:00
parent c7d0d8370c
commit 0a63a20e73
Signed by: rnhmjoj
GPG Key ID: BFBAF4C975F76450
5 changed files with 708 additions and 519 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1055
src/dispersion.f90
View File

File diff suppressed because it is too large Load Diff

16
src/eccd.f90
View File

@ -164,7 +164,7 @@ contains
eccdpar(4+nlm:npar) = chlm
end subroutine setcdcoeff_ncl
subroutine eccdeff(yg,anpl,anprre,dens,amu,ex,ey,ez,nhmn,nhmx, &
subroutine eccdeff(yg,anpl,anprre,dens,amu,e,nhmn,nhmx, &
ithn,cst2,fcur,eccdpar,effjcd,iokhawa,ierr)
use const_and_precisions, only : pi,qesi=>e_,mesi=>me_, &
vcsi=>c_,qe=>ecgs_,me=>mecgs_,vc=>ccgs_,mc2=>mc2_
@ -181,7 +181,7 @@ contains
integer :: i,nhmn,nhmx,ithn,iokhawa,ierr
real(wp_) :: yg,anpl,anprre,dens,amu,cst2,effjcd
real(wp_), dimension(:) :: eccdpar
complex(wp_) :: ex,ey,ez
complex(wp_) :: e(3)
! local variables
integer :: nhn,neval,ier,last,npar
integer, dimension(liw) :: iw
@ -202,12 +202,12 @@ contains
apar(2) = anpl
apar(3) = amu
apar(4) = anprre
apar(5) = dble(ex)
apar(6) = dimag(ex)
apar(7) = dble(ey)
apar(8) = dimag(ey)
apar(9) = dble(ez)
apar(10) = dimag(ez)
apar(5) = dble(e(1))
apar(6) = dimag(e(1))
apar(7) = dble(e(2))
apar(8) = dimag(e(2))
apar(9) = dble(e(3))
apar(10) = dimag(e(3))
apar(11) = dble(ithn)
npar=size(apar)

144
src/gray_core.f90
View File

@ -44,7 +44,8 @@ contains
real(wp_), parameter :: taucr = 12._wp_, etaucr = exp(-taucr)
character, dimension(2), parameter :: mode=['O','X']
real(wp_) :: sox,ak0,bres,xgcn,xg,yg,rrm,zzm,alpha,didp,anpl,anpr,anprim,anprre
integer :: sox
real(wp_) :: ak0,bres,xgcn,xg,yg,rrm,zzm,alpha,didp,anpl,anpr,anprim,anprre
real(wp_) :: chipol,psipol,btot,psinv,dens,tekev,dersdst,derdnm
real(wp_) :: tau,pow,dids,ddr,ddi,taumn,taumx
real(wp_) :: rhotpav,drhotpav,rhotjava,drhotjava,dpdvp,jphip
@ -160,7 +161,7 @@ contains
end if
end if
sox=one ! mode inverted for each beam
sox=1 ! mode inverted for each beam
iox=2 ! start with O: sox=-1, iox=1
psipol = params%antenna%psi
@ -425,9 +426,14 @@ contains
if(ierrn==0 .and. params%ecrh_cd%iwarm>0 .and. ins_pl .and. &
(tau1(jk)+tau0(jk)+lgcpl1(jk))<=taucr .and. .not.iwait(jk)) then ! H&CD computation check
tekev=temp(psinv)
call alpha_effj(params%ecrh_cd, psinv, xg, yg, dens, tekev, &
ak0, bres, derdnm, anpl, anpr, sox, anprre, &
anprim, alpha, didp, nharm, nhf, iokhawa, ierrhcd)
block
complex(wp_) :: Npr_warm
call alpha_effj(params%ecrh_cd, psinv, xg, yg, dens, tekev, &
ak0, bres, derdnm, anpl, anpr, sox, Npr_warm, &
alpha, didp, nharm, nhf, iokhawa, ierrhcd)
anprre = Npr_warm%re
anprim = Npr_warm%im
end block
if(ierrhcd/=0) then
error = ior(error,ierrhcd)
call print_errhcd(ierrhcd,i,anprre,anprim,alpha)
@ -965,12 +971,12 @@ contains
! use gray_params, only : igrad
use beamdata, only : h,hh,h6
implicit none
real(wp_), intent(in) :: sox,bres,xgcn
real(wp_), intent(in) :: bres,xgcn
real(wp_), dimension(6), intent(inout) :: y
real(wp_), dimension(6), intent(in) :: yp
real(wp_), dimension(3), intent(in) :: dgr
real(wp_), dimension(3,3), intent(in) :: ddgr
integer, intent(in) :: igrad
integer, intent(in) :: igrad,sox
real(wp_), dimension(6) :: yy,fk1,fk2,fk3,fk4
real(wp_) :: gr2
@ -998,11 +1004,11 @@ contains
implicit none
! arguments
real(wp_), dimension(6), intent(in) :: y
real(wp_), intent(in) :: sox,bres,xgcn,gr2
real(wp_), intent(in) :: bres,xgcn,gr2
real(wp_), dimension(3), intent(in) :: dgr2,dgr
real(wp_), dimension(3,3), intent(in) :: ddgr
real(wp_), dimension(6), intent(out) :: dery
integer, intent(in) :: igrad
integer, intent(in) :: igrad,sox
! local variables
real(wp_) :: psinv,dens,btot,xg,yg
real(wp_), dimension(3) :: xv,anv,bv,derxg,deryg
@ -1026,7 +1032,8 @@ contains
real(wp_), dimension(3), intent(in) :: xv,anv
real(wp_), dimension(3), intent(in) :: dgr
real(wp_), dimension(3,3), intent(in) :: ddgr
real(wp_), intent(in) :: sox,bres,xgcn
integer, intent(in) :: sox
real(wp_), intent(in) :: bres,xgcn
real(wp_), dimension(6), intent(out) :: dery
real(wp_), intent(out) :: psinv,dens,btot,xg,yg,anpl,anpr
real(wp_), intent(out) :: ddr,ddi,dersdst,derdnm
@ -1434,7 +1441,7 @@ contains
! 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
real(wp_), intent(in) :: sox
integer, intent(in) :: sox
! CMA diagram variables: X=(ω_pe/ω)², Y=ω_ce/ω
real(wp_), intent(in) :: xg, yg
! gradients of X, Y
@ -1690,12 +1697,12 @@ contains
subroutine alpha_effj(params, psinv, xg, yg, dens, tekev, ak0, bres, &
derdnm, anpl, anpr, sox, anprre, anprim, alpha, &
didp, nhmin, nhmax, iokhawa, error)
subroutine alpha_effj(params, psinv, X, Y, density, temperature, &
k0, Bres, derdnm, Npl, Npr_cold, sox, &
Npr, alpha, dIdp, nhmin, nhmax, iokhawa, error)
! Computes the absorption coefficient and effective current
use const_and_precisions, only : zero, pi, mc2=>mc2_
use const_and_precisions, only : pi, mc2=>mc2_
use gray_params, only : ecrh_cd_parameters
use coreprofiles, only : fzeff
use equilibrium, only : sgnbphi
@ -1715,24 +1722,24 @@ contains
! poloidal flux ψ
real(wp_), intent(in) :: psinv
! CMA diagram variables: X=(ω_pe/ω)², Y=ω_ce/ω
real(wp_), intent(in) :: xg, yg
! density [10¹⁹ m⁻³], temperature [keV]
real(wp_), intent(in) :: dens, tekev
real(wp_), intent(in) :: X, Y
! densityity [10¹⁹ m⁻³], temperature [keV]
real(wp_), intent(in) :: density, temperature
! vacuum wavenumber k₀=ω/c, resonant B field
real(wp_), intent(in) :: ak0, bres
real(wp_), intent(in) :: k0, Bres
! group velocity: |∂Λ/∂N̅| where Λ=c²/ω²⋅D_R
real(wp_), intent(in) :: derdnm
! refractive index: N∥, N⊥ (cold dispersion)
real(wp_), intent(in) :: anpl, anpr
real(wp_), intent(in) :: Npl, Npr_cold
! sign of polarisation mode: -1 ⇒ O, +1 ⇒ X
real(wp_), intent(in) :: sox
integer, intent(in) :: sox
! Outputs
! real/imaginary parts of N⊥ (warm dispersion)
real(wp_), intent(out) :: anprre, anprim
! orthogonal refractive index N⊥ (solution of the warm dispersion)
complex(wp_), intent(out) :: Npr
! absorption coefficient, current density
real(wp_), intent(out) :: alpha, didp
real(wp_), intent(out) :: alpha, dIdp
! lowest/highest resonant harmonic numbers
integer, intent(out) :: nhmin, nhmax
! ECCD/overall error codes
@ -1740,18 +1747,16 @@ contains
! local variables
real(wp_) :: rbavi, rrii, rhop
integer :: lrm, ithn, ierrcd
real(wp_) :: amu, rbn, rbx
integer :: nlarmor, ithn, ierrcd
real(wp_) :: mu, rbn, rbx
real(wp_) :: zeff, cst2, bmxi, bmni, fci
real(wp_), dimension(:), pointer :: eccdpar=>null()
real(wp_) :: effjcd, effjcdav, btot
real(wp_) :: akim
complex(wp_) :: ex, ey, ez
real(wp_) :: effjcd, effjcdav, Btot
complex(wp_) :: e(3)
alpha = zero
anprim = zero
anprre = zero
didp = zero
alpha = 0
Npr = 0
dIdp = 0
nhmin = 0
nhmax = 0
iokhawa = 0
@ -1760,37 +1765,52 @@ contains
! Absorption computation
! Skip when the temperature is zero (no plasma)
if (tekev <= zero) return
if (temperature <= 0) return
! Skip when the lowest resonant harmonic number is zero
amu = mc2/tekev ! μ=(mc²/kT)
call harmnumber(yg, amu, anpl, nhmin, nhmax, params%iwarm)
mu = mc2/temperature ! μ=(mc²/kT)
call harmnumber(Y, mu, Npl**2, params%iwarm == 1, nhmin, nhmax)
if (nhmin <= 0) return
! Solve the dispersion relation
lrm = max(params%ilarm, nhmax)
call warmdisp(xg, yg, amu, anpl, anpr, sox, lrm, error, &
anprre, anprim, params%iwarm, params%imx, &
ex, ey, ez)
! 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
! Compute α from the solution of the dispersion relation
! The absoption coefficient is defined as
!
! α = 2 Im(k̅)⋅s̅
!
! where s̅ = v̅_g/|v_g|, the direction of the energy flow.
! Since v̅_g = - ∂Λ/∂N̅ / ∂Λ/∂ω we have:
! Since v̅_g = - ∂Λ/∂N̅ / ∂Λ/∂ω, using the cold dispersion
! relation, we have that
!
! s̅ = ∂Λ/∂N̅ / |∂Λ/∂N̅|
! = -2N̅ / |∂Λ/∂N̅| (using the cold dispersion)
! = [2N̅ - ∂(N²s)/∂N∥ b̅
! + ½(b̅⋅∇S_I)² ∂³(N²s)/∂N∥³ b̅] / |∂Λ/∂N̅|
!
! Assuming Im(k∥)=0:
!
! α = 4 Im(k⊥)⋅N⊥ / |∂Λ/∂N̅|
!
akim = ak0 * anprim ! imaginary part of k⊥ = k₀N⊥
alpha = 4 * akim * anpr/derdnm
block
real(wp_) :: k_im
k_im = k0 * Npr%im ! imaginary part of k⊥
alpha = 4 * k_im*Npr_cold / derdnm
end block
if (alpha < zero) then
if (alpha < 0) then
error = ibset(error, palph)
return
end if
@ -1800,36 +1820,36 @@ contains
zeff = fzeff(psinv)
ithn = 1
if (lrm > nhmin) ithn = 2
if (nlarmor > nhmin) ithn = 2
rhop = sqrt(psinv)
call fluxval(rhop, rri=rrii, rbav=rbavi, bmn=bmni, bmx=bmxi, fc=fci)
btot = yg*bres
rbn = btot/bmni
rbx = btot/bmxi
Btot = Y*Bres
rbn = Btot/bmni
rbx = Btot/bmxi
select case(params%ieccd)
case(1)
! Cohen model
call setcdcoeff(zeff,rbn,rbx,cst2,eccdpar)
call eccdeff(yg,anpl,anprre,dens,amu,ex,ey,ez,nhmin,nhmax, &
ithn,cst2,fjch,eccdpar,effjcd,iokhawa,ierrcd)
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)
case(2)
! No trapping
call setcdcoeff(zeff,cst2,eccdpar)
call eccdeff(yg,anpl,anprre,dens,amu,ex,ey,ez,nhmin,nhmax, &
ithn,cst2,fjch0,eccdpar,effjcd,iokhawa,ierrcd)
call setcdcoeff(zeff, cst2, eccdpar)
call eccdeff(Y, Npl, Npr%re, density, mu, e, nhmin, nhmax, &
ithn, cst2, fjch0, eccdpar, effjcd, iokhawa, ierrcd)
case default
! Neoclassical model
call setcdcoeff(zeff,rbx,fci,amu,rhop,cst2,eccdpar)
call eccdeff(yg,anpl,anprre,dens,amu,ex,ey,ez,nhmin,nhmax, &
ithn,cst2,fjncl,eccdpar,effjcd,iokhawa,ierrcd)
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)
end select
error = error + ierrcd
if (associated(eccdpar)) deallocate(eccdpar)
! current drive efficiency <j/p> [A⋅m/W]
effjcdav = rbavi*effjcd
didp = sgnbphi * effjcdav / (2.0_wp_*pi*rrii)
dIdp = sgnbphi * effjcdav / (2*pi*rrii)
end subroutine alpha_effj
@ -1846,8 +1866,8 @@ contains
! subroutine arguments
real(wp_), dimension(6, nray), intent(in) :: ywrk0
real(wp_), intent(in) :: bres, sox
integer, intent(in) :: ipol
real(wp_), intent(in) :: bres
integer, intent(in) :: sox, ipol
real(wp_), intent(inout) :: psipol0, chipol0
complex(wp_), dimension(nray), intent(out) :: ext0, eyt0

9
src/multipass.f90
View File

@ -19,7 +19,8 @@ contains
! arguments
integer, intent(in) :: i ! ray index
real(wp_), dimension(3), intent(in) :: xv,anv
real(wp_), intent(in) :: bres,sox
real(wp_), intent(in) :: bres
integer, intent(in) :: sox
real(wp_), dimension(2), intent(out) :: cpl ! coupling (O/X)
real(wp_), intent(out) :: psipol1,chipol1
integer, dimension(:), intent(inout), pointer :: iop ! in/out plasma flag
@ -67,7 +68,8 @@ contains
! arguments
integer, intent(in) :: i ! ray index
real(wp_), dimension(3), intent(in) :: xv,anv
real(wp_), intent(in) :: bres,sox
real(wp_), intent(in) :: bres
integer, intent(in) :: sox
integer, dimension(:), intent(inout), pointer :: iop ! in/out plasma flag
complex(wp_), dimension(:), intent(out), pointer :: ext,eyt
! local variables
@ -101,7 +103,8 @@ contains
integer, intent(in) :: i ! ray index
logical, intent(in) :: ins ! inside plasma? (ins=1 plasma/wall overlap)
real(wp_), dimension(3), intent(inout) :: xv,anv
real(wp_), intent(in) :: bres,sox
real(wp_), intent(in) :: bres
integer, intent(in) :: sox
real(wp_), intent(out) :: psipol1,chipol1
integer, dimension(:), intent(inout), pointer :: iow,iop ! in/out vessel and plasma flags
complex(wp_), dimension(:), intent(inout), pointer :: ext,eyt

3
src/polarization.f90
View File

@ -51,7 +51,8 @@ contains
implicit none
! arguments
real(wp_), dimension(3), intent(in) :: anv,bv
real(wp_), intent(in) :: bres,sox
real(wp_), intent(in) :: bres
integer, intent(in) :: sox
complex(wp_), intent(out) :: ext,eyt
! real(wp_), optional, intent(out) :: gam
! local variables