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

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

142
src/gray_core.f90
View File

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

9
src/multipass.f90
View File

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

3
src/polarization.f90
View File

@ -51,7 +51,8 @@ contains
implicit none implicit none
! arguments ! arguments
real(wp_), dimension(3), intent(in) :: anv,bv 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 complex(wp_), intent(out) :: ext,eyt
! real(wp_), optional, intent(out) :: gam ! real(wp_), optional, intent(out) :: gam
! local variables ! local variables