reorganized reading of input parameters and data files. Created f90 main program handling file reads and passing arrays to the main gray subroutine.
This commit is contained in:
parent
e1ba175efb
commit
4bb85f0dc1
36
Makefile
36
Makefile
@ -2,11 +2,11 @@
|
||||
EXE=gray
|
||||
|
||||
# Objects list
|
||||
MAINOBJ=gray.o
|
||||
OTHOBJ=conical.o const_and_precisions.o coreprofiles.o dierckx.o dispersion.o \
|
||||
eccd.o eierf.o graydata_anequil.o graydata_flags.o graydata_par.o \
|
||||
equilibrium.o magsurf_data.o math.o minpack.o numint.o quadpack.o \
|
||||
reflections.o simplespline.o utils.o beamdata.o
|
||||
MAINOBJ=main.o
|
||||
OTHOBJ= beamdata.o beams.o conical.o const_and_precisions.o coreprofiles.o \
|
||||
dierckx.o dispersion.o eccd.o eierf.o graycore.o gray-externals.o \
|
||||
gray_params.o equilibrium.o magsurf_data.o math.o minpack.o numint.o \
|
||||
quadpack.o reflections.o simplespline.o utils.o
|
||||
|
||||
# Alternative search paths
|
||||
vpath %.f90 src
|
||||
@ -14,7 +14,8 @@ vpath %.f src
|
||||
|
||||
# Fortran compiler name and flags
|
||||
FC=gfortran
|
||||
FFLAGS=-O3 #-Wall -g -fcheck=all
|
||||
FFLAGS=-O3
|
||||
#FFLAGS=-Wall -g -finit-real=nan -ffpe-trap=invalid -fcheck=all -fbounds-check
|
||||
|
||||
DIRECTIVES = -DREVISION="'$(shell svnversion src)'"
|
||||
|
||||
@ -25,20 +26,24 @@ $(EXE): $(MAINOBJ) $(OTHOBJ)
|
||||
$(FC) $(FFLAGS) -o $@ $^
|
||||
|
||||
# Dependencies on modules
|
||||
gray.o: const_and_precisions.o coreprofiles.o dierckx.o dispersion.o eccd.o \
|
||||
graydata_anequil.o graydata_flags.o graydata_par.o \
|
||||
main.o: const_and_precisions.o beams.o coreprofiles.o equilibrium.o \
|
||||
graycore.o gray_params.o reflections.o
|
||||
graycore.o: const_and_precisions.o beamdata.o beams.o equilibrium.o \
|
||||
gray-externals.o gray_params.o reflections.o
|
||||
gray-externals.o: const_and_precisions.o beams.o coreprofiles.o dierckx.o \
|
||||
dispersion.o eccd.o gray_params.o \
|
||||
equilibrium.o magsurf_data.o math.o numint.o quadpack.o \
|
||||
reflections.o simplespline.o utils.o beamdata.o
|
||||
reflections.o simplespline.o utils.o beamdata.o
|
||||
beams.o: const_and_precisions.o simplespline.o utils.o
|
||||
beamdata.o: const_and_precisions.o gray_params.o
|
||||
conical.o: const_and_precisions.o
|
||||
coreprofiles.o: const_and_precisions.o dierckx.o graydata_anequil.o \
|
||||
graydata_flags.o simplespline.o utils.o
|
||||
coreprofiles.o: const_and_precisions.o dierckx.o gray_params.o simplespline.o \
|
||||
utils.o
|
||||
dierckx.o: const_and_precisions.o
|
||||
dispersion.o: const_and_precisions.o eierf.o math.o quadpack.o
|
||||
eccd.o: const_and_precisions.o conical.o magsurf_data.o dierckx.o numint.o
|
||||
eierf.o: const_and_precisions.o
|
||||
graydata_anequil.o: const_and_precisions.o
|
||||
graydata_flags.o: const_and_precisions.o
|
||||
graydata_par.o: const_and_precisions.o
|
||||
gray_params.o: const_and_precisions.o utils.o
|
||||
equilibrium.o: const_and_precisions.o dierckx.o minpack.o simplespline.o utils.o
|
||||
magsurf_data.o: const_and_precisions.o
|
||||
math.o: const_and_precisions.o
|
||||
@ -48,7 +53,6 @@ quadpack.o: const_and_precisions.o
|
||||
reflections.o: const_and_precisions.o utils.o
|
||||
simplespline.o: const_and_precisions.o
|
||||
utils.o: const_and_precisions.o
|
||||
beamdata.o: const_and_precisions.o
|
||||
|
||||
# General object compilation command
|
||||
%.o: %.f90
|
||||
@ -57,7 +61,7 @@ beamdata.o: const_and_precisions.o
|
||||
%.o: %.f
|
||||
$(FC) $(FFLAGS) -c $<
|
||||
|
||||
gray.o:gray.f
|
||||
gray-externals.o:gray-externals.f
|
||||
$(FC) -cpp $(DIRECTIVES) $(FFLAGS) -c $<
|
||||
|
||||
.PHONY: clean install
|
||||
|
||||
105
src/beamdata.f90
105
src/beamdata.f90
@ -3,13 +3,14 @@ module beamdata
|
||||
implicit none
|
||||
|
||||
integer, parameter :: jmx=31,kmx=36,nmx=8000
|
||||
integer, save :: nrayr,nrayth,nstep
|
||||
integer, save :: nray,nrayr,nrayth,nstep
|
||||
real(wp_) :: dst,rwmax
|
||||
real(wp_), dimension(:,:,:), allocatable, save :: psjki,ppabs,ccci,tauv,alphav
|
||||
real(wp_), dimension(:,:,:), allocatable, save :: pdjki,currj,didst
|
||||
integer, dimension(:,:), allocatable, save :: iiv,iop,iow,ihcd,istore
|
||||
real(wp_), dimension(:,:), allocatable, save :: tau1v
|
||||
real(wp_), dimension(:), allocatable, save :: q
|
||||
real(wp_), dimension(:,:,:), allocatable, save :: yyrfl !(:,:,6)
|
||||
real(wp_), dimension(:,:,:), allocatable, save :: yyrfl !(6,:,:)
|
||||
real(wp_), dimension(:,:,:), allocatable, save :: ywrk,ypwrk !(6,:,:)
|
||||
real(wp_), dimension(:,:,:), allocatable, save :: xc,xco,du1,du1o !(3,:,:)
|
||||
real(wp_), dimension(:,:,:), allocatable, save :: gri,dgrad2v !(3,:,:)
|
||||
@ -20,9 +21,80 @@ module beamdata
|
||||
|
||||
contains
|
||||
|
||||
subroutine alloc_beam(ierr)
|
||||
subroutine init_rtr(rtrparam)
|
||||
use gray_params, only : rtrparam_type
|
||||
implicit none
|
||||
type(rtrparam_type), intent(in) :: rtrparam
|
||||
|
||||
dst=rtrparam%dst
|
||||
rwmax=rtrparam%rwmax
|
||||
nrayr=rtrparam%nrayr
|
||||
nrayth=rtrparam%nrayth
|
||||
if(nrayr==1) nrayth=1
|
||||
nray=(nrayr-1)*nrayth+1
|
||||
nstep=rtrparam%nstep
|
||||
call alloc_beam
|
||||
! call alloc_beam1
|
||||
end subroutine init_rtr
|
||||
|
||||
function rayi2jk(i) result(jk)
|
||||
implicit none
|
||||
integer, intent(in) :: i
|
||||
integer, dimension(2) :: jk
|
||||
integer :: ioff
|
||||
|
||||
if (i>1) then
|
||||
ioff = i - 2
|
||||
jk(1) = ioff/nrayth ! jr-2
|
||||
jk(2) = ioff - (jk(1))*nrayth + 1 ! kt
|
||||
! jk(2) = mod(ioff,nrayth) + 1 ! kt
|
||||
jk(1) = jk(1) + 2 ! jr
|
||||
else
|
||||
jk = 1
|
||||
end if
|
||||
end function rayi2jk
|
||||
|
||||
function rayi2j(i) result(jr)
|
||||
implicit none
|
||||
integer, intent(in) :: i
|
||||
integer :: jr
|
||||
|
||||
! jr = max(1, (i-2)/nrayth + 2)
|
||||
if (i>1) then
|
||||
jr = (i-2)/nrayth + 2
|
||||
else
|
||||
jr = 1
|
||||
end if
|
||||
end function rayi2j
|
||||
|
||||
function rayi2k(i) result(kt)
|
||||
implicit none
|
||||
integer, intent(in) :: i
|
||||
integer :: kt
|
||||
|
||||
! kt = max(1, mod(i-2,nrayth) + 1)
|
||||
if (i>1) then
|
||||
kt = mod(i-2,nrayth) + 1
|
||||
else
|
||||
kt = 1
|
||||
end if
|
||||
end function rayi2k
|
||||
|
||||
function rayjk2i(jr,kt) result(i)
|
||||
implicit none
|
||||
integer, intent(in) :: jr,kt
|
||||
integer :: i
|
||||
|
||||
! i = max(1, (jr-2)*nrayth + kt + 1)
|
||||
if (jr>1) then
|
||||
i = (jr-2)*nrayth + kt + 1
|
||||
else
|
||||
i = 1
|
||||
end if
|
||||
end function rayjk2i
|
||||
|
||||
subroutine alloc_beam
|
||||
implicit none
|
||||
integer, intent(out) :: ierr
|
||||
|
||||
call dealloc_beam
|
||||
allocate(psjki(nrayr,nrayth,nstep), ppabs(nrayr,nrayth,nstep), &
|
||||
@ -32,18 +104,35 @@ contains
|
||||
iiv(nrayr,nrayth), iop(nrayr,nrayth), &
|
||||
iow(nrayr,nrayth), tau1v(nrayr,nrayth), &
|
||||
ihcd(nrayr,nrayth), istore(nrayr,nrayth), &
|
||||
q(nrayr), yyrfl(nrayr,nrayth,6), &
|
||||
q(nrayr), yyrfl(6,nrayr,nrayth), &
|
||||
ywrk(6,nrayr,nrayth), ypwrk(6,nrayr,nrayth), &
|
||||
xc(3,nrayr,nrayth), xco(3,nrayr,nrayth), &
|
||||
du1(3,nrayr,nrayth), du1o(3,nrayr,nrayth), &
|
||||
gri(3,nrayr,nrayth), dgrad2v(3,nrayr,nrayth), &
|
||||
ggri(3,3,nrayr,nrayth), grad2(nrayr,nrayth), &
|
||||
dffiu(nrayr), ddffiu(nrayr), &
|
||||
ext(nrayr,nrayth,0:4), eyt(nrayr,nrayth,0:4), &
|
||||
stat=ierr)
|
||||
if (ierr/=0) call dealloc_beam
|
||||
ext(nrayr,nrayth,0:4), eyt(nrayr,nrayth,0:4))
|
||||
end subroutine alloc_beam
|
||||
|
||||
! subroutine alloc_beam1
|
||||
! implicit none
|
||||
! integer, intent(out) :: ierr
|
||||
!
|
||||
! call dealloc_beam
|
||||
! allocate(psjki(nray,nstep), ppabs(nray,nstep), pdjki(nray,nstep), &
|
||||
! ccci(nray,nstep), currj(nray,nstep), didst(nray,nstep), &
|
||||
! tauv(nray,nstep), alphav(nray,nstep), &
|
||||
! ywrk(6,nray), ypwrk(6,nray), &
|
||||
! xc(3,nray), xco(3,nray), &
|
||||
! du1(3,nray), du1o(3,nray), &
|
||||
! grad2(nray), dgrad2v(3,nray), &
|
||||
! gri(3,nray), ggri(3,3,nray), &
|
||||
! dffiu(nrayr), ddffiu(nrayr), q(nrayr), &
|
||||
! iiv(nray), iop(nray), iow(nray), &
|
||||
! ihcd(nray), istore(nray), tau1v(nray), &
|
||||
! yyrfl(6,nray), ext(nray,0:4), eyt(nray,0:4))
|
||||
! end subroutine alloc_beam1
|
||||
!
|
||||
subroutine dealloc_beam
|
||||
implicit none
|
||||
if (allocated(psjki)) deallocate(psjki)
|
||||
|
||||
217
src/beams.f90
Normal file
217
src/beams.f90
Normal file
@ -0,0 +1,217 @@
|
||||
module beams
|
||||
use const_and_precisions, only : wp_
|
||||
implicit none
|
||||
|
||||
contains
|
||||
|
||||
subroutine read_beam0(file_beam,alpha0,beta0,fghz,x00,y00,z00, &
|
||||
wcsi,weta,rcicsi,rcieta,phiw,phir,unit)
|
||||
use const_and_precisions, only : pi,vc=>ccgs_
|
||||
use utils, only : get_free_unit
|
||||
implicit none
|
||||
! arguments
|
||||
character(len=*), intent(in) :: file_beam
|
||||
real(wp_), intent(in) :: alpha0,beta0
|
||||
real(wp_), intent(out) :: fGHz,x00,y00,z00
|
||||
real(wp_), intent(out) :: wcsi,weta,rcicsi,rcieta,phir,phiw
|
||||
integer, intent(in), optional :: unit
|
||||
! local variables
|
||||
integer :: u
|
||||
real(wp_) :: ak0,zrcsi,zreta,w0csi,w0eta,d0csi,d0eta
|
||||
|
||||
if (present(unit)) then
|
||||
u=unit
|
||||
else
|
||||
u = get_free_unit()
|
||||
end if
|
||||
open(unit=u,file=trim(file_beam),status='OLD',action='READ')
|
||||
|
||||
! fghz wave frequency (GHz)
|
||||
read(u,*) fGHz
|
||||
! x00,y00,z00 coordinates of launching point in cm
|
||||
read(u,*) x00, y00, z00
|
||||
! beams parameters in local reference system
|
||||
! w0 -> waist, d0 -> waist distance from launching point
|
||||
! phiw angle of spot ellipse
|
||||
read(u,*) w0csi,w0eta,d0csi,d0eta,phiw
|
||||
close(u)
|
||||
|
||||
ak0=2.0e9_wp_*pi*fghz/vc
|
||||
zrcsi=0.5_wp_*ak0*w0csi**2
|
||||
zreta=0.5_wp_*ak0*w0eta**2
|
||||
|
||||
wcsi=w0csi*sqrt(1.0_wp_+(d0csi/zrcsi)**2)
|
||||
weta=w0eta*sqrt(1.0_wp_+(d0eta/zreta)**2)
|
||||
rcicsi=-d0csi/(d0csi**2+zrcsi**2)
|
||||
rcieta=-d0eta/(d0eta**2+zreta**2)
|
||||
phir=phiw
|
||||
|
||||
end subroutine read_beam0
|
||||
|
||||
|
||||
|
||||
subroutine read_beam1(file_beam,alpha0,beta0,fghz,x00,y00,z00, &
|
||||
wcsi,weta,rcicsi,rcieta,phiw,phir,unit)
|
||||
use const_and_precisions, only : pi,vc=>ccgs_
|
||||
use simplespline, only : spli, difcs
|
||||
use utils, only : get_free_unit,locate
|
||||
implicit none
|
||||
! arguments
|
||||
character(len=*), intent(in) :: file_beam
|
||||
real(wp_), intent(in) :: alpha0
|
||||
real(wp_), intent(out) :: fghz,x00,y00,z00,beta0
|
||||
real(wp_), intent(out) :: wcsi,weta,rcicsi,rcieta,phir,phiw
|
||||
integer, intent(in), optional :: unit
|
||||
! local variables
|
||||
integer :: u,ierr,iopt,ier,nisteer,i,k,ii
|
||||
real(wp_) :: steer,alphast,betast,x00mm,y00mm,z00mm
|
||||
real(wp_) :: w1,w2,rci1,rci2,phi1,phi2,dal
|
||||
real(wp_), dimension(:), allocatable :: alphastv,betastv,x00v,y00v, &
|
||||
z00v,waist1v,waist2v,rci1v,rci2v,phi1v,phi2v, &
|
||||
cbeta,cx0,cy0,cz0,cwaist1,cwaist2, &
|
||||
crci1,crci2,cphi1,cphi2
|
||||
|
||||
if (present(unit)) then
|
||||
u=unit
|
||||
else
|
||||
u = get_free_unit()
|
||||
end if
|
||||
open(unit=u,file=file_beam,status='OLD',action='READ')
|
||||
|
||||
read(u,*) fghz
|
||||
|
||||
read(u,*) nisteer
|
||||
|
||||
allocate(alphastv(nisteer),betastv(nisteer),waist1v(nisteer), &
|
||||
waist2v(nisteer),rci1v(nisteer),rci2v(nisteer), &
|
||||
phi1v(nisteer),phi2v(nisteer),x00v(nisteer), &
|
||||
y00v(nisteer),z00v(nisteer),cbeta(4*nisteer), &
|
||||
cx0(4*nisteer),cy0(4*nisteer),cz0(4*nisteer), &
|
||||
cwaist1(4*nisteer),cwaist2(4*nisteer),crci1(4*nisteer), &
|
||||
crci2(4*nisteer),cphi1(4*nisteer),cphi2(4*nisteer), &
|
||||
stat=ierr)
|
||||
if (ierr/=0) then
|
||||
close(u)
|
||||
deallocate(alphastv,betastv,waist1v,waist2v,rci1v,rci2v, &
|
||||
phi1v,phi2v,x00v,y00v,z00v,cbeta, &
|
||||
cx0,cy0,cz0,cwaist1,cwaist2,crci1,crci2,cphi1,cphi2)
|
||||
write(*,*) 'cannot allocate arrays for beam data'
|
||||
stop
|
||||
end if
|
||||
|
||||
do i=1,nisteer
|
||||
read(u,*) steer,alphast,betast,x00mm,y00mm,z00mm, &
|
||||
w1,w2,rci1,rci2,phi1,phi2
|
||||
! initial beam data measured in mm -> transformed to cm
|
||||
x00v(i)=0.1_wp_*x00mm
|
||||
y00v(i)=0.1_wp_*y00mm
|
||||
z00v(i)=0.1_wp_*z00mm
|
||||
alphastv(i)=alphast
|
||||
betastv(i)=betast
|
||||
waist1v(i)=0.1_wp_*w1
|
||||
rci1v(i)=1.0e1_wp_*rci1
|
||||
waist2v(i)=0.1_wp_*w2
|
||||
rci2v(i)=1.0e1_wp_*rci2
|
||||
phi1v(i)=phi1
|
||||
phi2v(i)=phi2
|
||||
end do
|
||||
close(u)
|
||||
|
||||
iopt=0
|
||||
call difcs(alphastv,betastv,nisteer,iopt,cbeta,ier)
|
||||
call difcs(alphastv,waist1v,nisteer,iopt,cwaist1,ier)
|
||||
call difcs(alphastv,rci1v,nisteer,iopt,crci1,ier)
|
||||
call difcs(alphastv,waist2v,nisteer,iopt,cwaist2,ier)
|
||||
call difcs(alphastv,rci2v,nisteer,iopt,crci2,ier)
|
||||
call difcs(alphastv,phi1v,nisteer,iopt,cphi1,ier)
|
||||
call difcs(alphastv,phi2v,nisteer,iopt,cphi2,ier)
|
||||
call difcs(alphastv,x00v,nisteer,iopt,cx0,ier)
|
||||
call difcs(alphastv,y00v,nisteer,iopt,cy0,ier)
|
||||
call difcs(alphastv,z00v,nisteer,iopt,cz0,ier)
|
||||
|
||||
if((alpha0 > alphastv(1)).and.(alpha0 < alphastv(nisteer))) then
|
||||
call locate(alphastv,nisteer,alpha0,k)
|
||||
dal=alpha0-alphastv(k)
|
||||
beta0=spli(cbeta,nisteer,k,dal)
|
||||
x00=spli(cx0,nisteer,k,dal)
|
||||
y00=spli(cy0,nisteer,k,dal)
|
||||
z00=spli(cz0,nisteer,k,dal)
|
||||
wcsi=spli(cwaist1,nisteer,k,dal)
|
||||
weta=spli(cwaist2,nisteer,k,dal)
|
||||
rcicsi=spli(crci1,nisteer,k,dal)
|
||||
rcieta=spli(crci2,nisteer,k,dal)
|
||||
phiw=spli(cphi1,nisteer,k,dal)
|
||||
phir=spli(cphi2,nisteer,k,dal)
|
||||
else
|
||||
write(*,*) ' alpha0 outside table range !!!'
|
||||
if(alpha0 >= alphastv(nisteer)) ii=nisteer
|
||||
if(alpha0 <= alphastv(1)) ii=1
|
||||
beta0=betastv(ii)
|
||||
x00=x00v(ii)
|
||||
y00=y00v(ii)
|
||||
z00=z00v(ii)
|
||||
wcsi=waist1v(ii)
|
||||
weta=waist2v(ii)
|
||||
rcicsi=rci1v(ii)
|
||||
rcieta=rci2v(ii)
|
||||
phiw=phi1v(ii)
|
||||
phir=phi2v(ii)
|
||||
end if
|
||||
|
||||
deallocate(alphastv,betastv,waist1v,waist2v,rci1v,rci2v, &
|
||||
phi1v,phi2v,x00v,y00v,z00v,cbeta, &
|
||||
cx0,cy0,cz0,cwaist1,cwaist2,crci1,crci2,cphi1,cphi2)
|
||||
|
||||
end subroutine read_beam1
|
||||
|
||||
subroutine launchangles2n(alpha,beta,x,y,z,anx,any,anz)
|
||||
use const_and_precisions, only : degree
|
||||
implicit none
|
||||
! arguments
|
||||
real(wp_), intent(in) :: alpha,beta,x,y,z
|
||||
real(wp_), intent(out) :: anx,any,anz
|
||||
! local variables
|
||||
real(wp_) :: r,anr,anphi
|
||||
|
||||
r=sqrt(x**2+y**2)
|
||||
! phi=atan2(y,x)
|
||||
print'(a,2f8.3)','alpha0, beta0 = ',alpha,beta
|
||||
print'(a,4f8.3)','x00, y00, R00, z00 = ',x,y,r,z
|
||||
print*,' '
|
||||
!
|
||||
! angles alpha, beta in a local reference system as proposed by Gribov et al
|
||||
!
|
||||
anr = -cos(degree*beta)*cos(degree*alpha)
|
||||
anphi = sin(degree*beta)
|
||||
! anx = -cos(degree*beta)*cos(degree*alpha)
|
||||
! any = sin(degree*beta)
|
||||
|
||||
anx = (anr*x - anphi*y)/r
|
||||
any = (anr*y + anphi*x)/r
|
||||
! anr = (anx*x + any*y)/r
|
||||
! anphi = (any*x - anx*y)/r
|
||||
|
||||
anz =-cos(degree*beta)*sin(degree*alpha)
|
||||
end subroutine launchangles2n
|
||||
|
||||
subroutine xgygcoeff(fghz,ak0,bres,xgcn)
|
||||
use const_and_precisions, only : qe=>ecgs_,me=>mecgs_,vc=>ccgs_,pi,wce1_
|
||||
implicit none
|
||||
! arguments
|
||||
real(wp_), intent(in) :: fghz
|
||||
real(wp_), intent(out) :: ak0,bres,xgcn
|
||||
! local variables
|
||||
real(wp_) :: omega
|
||||
|
||||
omega=2.0e9_wp_*pi*fghz ! [rad/s]
|
||||
ak0=omega/vc ! [rad/cm]
|
||||
!
|
||||
! yg=btot/bres
|
||||
!
|
||||
bres=omega/wce1_ ! [T]
|
||||
!
|
||||
! xg=xgcn*dens19
|
||||
!
|
||||
xgcn=1.0e-5_wp_*qe**2/(pi*me*fghz**2) ! [10^-19 m^3]
|
||||
end subroutine xgygcoeff
|
||||
end module beams
|
||||
@ -102,7 +102,7 @@
|
||||
REAL(wp_), PARAMETER :: mu0inv = 1._wp_/mu0_ !
|
||||
! REAL(wp_), PARAMETER :: mc_ = me_*c_ ! [kg*m/s]
|
||||
! ! f_ce = fce1_*B (B in Tesla): !
|
||||
! REAL(wp_), PARAMETER :: wce1_ = e_/me_ ! [rad/s]
|
||||
REAL(wp_), PARAMETER :: wce1_ = e_/me_ ! [rad/s]
|
||||
! REAL(wp_), PARAMETER :: fce1_ = wce1_/(2*pi) ! [1/s]
|
||||
! ! f_pl = fpe1_*sqrt(Ne) (Ne in 1/m**3): !
|
||||
! REAL(wp_), PARAMETER :: wpe1_ = 56.4049201 ! [rad/s]
|
||||
|
||||
@ -11,8 +11,7 @@ module coreprofiles
|
||||
contains
|
||||
|
||||
subroutine density(psin,dens,ddens)
|
||||
use graydata_flags, only : iprof
|
||||
! use graydata_anequil, only : dens0,aln1,aln2
|
||||
use gray_params, only : iprof
|
||||
use dierckx, only : splev,splder
|
||||
implicit none
|
||||
! arguments
|
||||
@ -68,18 +67,17 @@ contains
|
||||
if(ier > 0) print*,ier
|
||||
if(abs(dens) < 1.0e-10_wp_) dens=zero
|
||||
end if
|
||||
! if(dens < zero) print*,' DENSITY NEGATIVE',dens
|
||||
if(dens < zero) then
|
||||
dens=zero
|
||||
ddens=zero
|
||||
end if
|
||||
if(dens < zero) print*,' DENSITY NEGATIVE',dens
|
||||
! if(dens < zero) then
|
||||
! dens=zero
|
||||
! ddens=zero
|
||||
! end if
|
||||
end if
|
||||
end subroutine density
|
||||
|
||||
function temp(psin)
|
||||
use const_and_precisions, only : wp_,zero,one
|
||||
use graydata_flags, only : iprof
|
||||
! use graydata_anequil, only : te0,dte0,alt1,alt2
|
||||
use gray_params, only : iprof
|
||||
use utils, only : locate
|
||||
use simplespline, only :spli
|
||||
implicit none
|
||||
@ -105,8 +103,7 @@ contains
|
||||
|
||||
function fzeff(psin)
|
||||
use const_and_precisions, only : wp_,zero,one
|
||||
use graydata_flags, only : iprof
|
||||
! use graydata_anequil, only : zeffan
|
||||
use gray_params, only : iprof
|
||||
use utils, only : locate
|
||||
use simplespline, only :spli
|
||||
implicit none
|
||||
@ -144,7 +141,7 @@ contains
|
||||
else
|
||||
u=get_free_unit()
|
||||
end if
|
||||
open(file=trim(filenm),status='old',unit=u)
|
||||
open(file=trim(filenm),status='old',action='read',unit=u)
|
||||
read(u,*) n
|
||||
if(allocated(psin)) deallocate(psin)
|
||||
if(allocated(te)) deallocate(te)
|
||||
@ -179,21 +176,22 @@ contains
|
||||
if(allocated(zeff)) deallocate(zeff)
|
||||
allocate(te(4),ne(3),zeff(1))
|
||||
|
||||
open(file=trim(filenm),status='old',unit=u)
|
||||
open(file=trim(filenm),status='old',action='read',unit=u)
|
||||
read(u,*) ne(1:3) ! dens0,aln1,aln2
|
||||
read(u,*) te(1:4) ! te0,dte0,alt1,alt2
|
||||
read(u,*) zeff(1) ! zeffan
|
||||
close(u)
|
||||
end subroutine read_profiles_an
|
||||
|
||||
subroutine tene_scal(te,ne,tfact,nfact,bfact,iscal)
|
||||
subroutine tene_scal(te,ne,tfact,nfact,bfact,iscal,iprof)
|
||||
implicit none
|
||||
! arguments
|
||||
real(wp_), dimension(:), intent(inout) :: te,ne
|
||||
real(wp_), intent(in) :: tfact,nfact,bfact
|
||||
integer, intent(in) :: iscal
|
||||
integer, intent(in) :: iscal,iprof
|
||||
! local variables
|
||||
real(wp_) :: aat,aan,ffact
|
||||
integer :: lastte,lastne
|
||||
|
||||
if (iscal==0) then
|
||||
aat=2.0_wp_/3.0_wp_
|
||||
@ -207,21 +205,28 @@ contains
|
||||
else
|
||||
ffact=bfact
|
||||
end if
|
||||
te(:)=te(:)*ffact**aat*tfact
|
||||
ne(:)=ne(:)*ffact**aan*nfact
|
||||
if (iprof==0) then
|
||||
lastte=2
|
||||
lastne=1
|
||||
else
|
||||
lastte=size(te)
|
||||
lastne=size(ne)
|
||||
end if
|
||||
te(1:lastte)=te(1:lastte)*ffact**aat*tfact
|
||||
ne(1:lastne)=ne(1:lastne)*ffact**aan*nfact
|
||||
end subroutine tene_scal
|
||||
|
||||
subroutine set_prfspl(psin,te,ne,zeff,ssplne)
|
||||
subroutine set_prfspl(psin,te,ne,zeff,ssplne,psdbndmx)
|
||||
use simplespline, only : difcs
|
||||
use dierckx, only : curfit, splev, splder
|
||||
implicit none
|
||||
! arguments
|
||||
real(wp_), dimension(:), intent(in) :: psin,te,ne,zeff
|
||||
real(wp_), intent(in) :: ssplne
|
||||
real(wp_), intent(in) :: ssplne,psdbndmx
|
||||
! local variables
|
||||
integer, parameter :: iopt=0, kspl=3
|
||||
integer :: n, npest, lwrkf, ier
|
||||
real(wp_) :: xb, xe, fp, xnv, ynv
|
||||
real(wp_) :: xb, xe, fp, xnv, xxp,xxm,delta2
|
||||
real(wp_), dimension(:), allocatable :: wf, wrkf
|
||||
integer, dimension(:), allocatable :: iwrkf
|
||||
real(wp_), dimension(1) :: dedge,ddedge,d2dedge
|
||||
@ -266,25 +271,29 @@ contains
|
||||
! 2nd order derivative, extending the profile up to psi=psdbnd where
|
||||
! ne=ne'=ne''=0
|
||||
! spline value and derivatives at the edge
|
||||
call splev(tfn,nsfd,cfn,3,psin(n:n),dedge(1:1),1,ier)
|
||||
call splder(tfn,nsfd,cfn,3,1,psin(n:n),ddedge(1:1), 1,wrkf(1:nsfd),ier)
|
||||
call splder(tfn,nsfd,cfn,3,2,psin(n:n),d2dedge(1:1),1,wrkf(1:nsfd),ier)
|
||||
call splev(tfn,nsfd,cfn,kspl,psin(n:n),dedge(1:1),1,ier)
|
||||
call splder(tfn,nsfd,cfn,kspl,1,psin(n:n),ddedge(1:1), 1,wrkf(1:nsfd),ier)
|
||||
call splder(tfn,nsfd,cfn,kspl,2,psin(n:n),d2dedge(1:1),1,wrkf(1:nsfd),ier)
|
||||
! determination of the boundary
|
||||
psdbnd=psdbndmx
|
||||
|
||||
psnpp=psin(n)
|
||||
denpp=dedge(1)
|
||||
ddenpp=ddedge(1)
|
||||
d2denpp=d2dedge(1)
|
||||
psdbnd=psnpp
|
||||
if(ddenpp < zero) then
|
||||
xnv=psnpp-ddenpp/d2denpp
|
||||
ynv=denpp-0.5_wp_*ddenpp**2/d2denpp
|
||||
if((d2denpp > zero).and.(ynv >= zero)) then
|
||||
psdbnd=xnv
|
||||
else
|
||||
psdbnd=xnv+sqrt((ddenpp/d2denpp)**2-2.0_wp_*denpp/d2denpp)
|
||||
end if
|
||||
print*,psnpp,denpp,ddenpp,d2denpp,xnv,ynv
|
||||
print*,psdbnd
|
||||
|
||||
delta2=(ddenpp/d2denpp)**2-2.0_wp_*denpp/d2denpp
|
||||
xnv=psnpp-ddenpp/d2denpp
|
||||
if(delta2 < zero) then
|
||||
if(xnv > psnpp) psdbnd=min(psdbnd,xnv)
|
||||
else
|
||||
xxm=xnv-sqrt(delta2)
|
||||
xxp=xnv+sqrt(delta2)
|
||||
if(xxm > psnpp) then
|
||||
psdbnd=min(psdbnd,xxm)
|
||||
else if (xxp > psnpp) then
|
||||
psdbnd=min(psdbnd,xxp)
|
||||
end if
|
||||
end if
|
||||
|
||||
deallocate(iwrkf,wrkf,wf)
|
||||
|
||||
@ -2,12 +2,12 @@ module equilibrium
|
||||
use const_and_precisions, only : wp_
|
||||
implicit none
|
||||
|
||||
REAL(wp_), SAVE :: btaxis,rmaxis,zmaxis
|
||||
REAL(wp_), SAVE :: btaxis,rmaxis,zmaxis,sgnbphi
|
||||
REAL(wp_), SAVE :: btrcen ! used only for Jcd_ASTRA def.
|
||||
REAL(wp_), SAVE :: rcen ! computed as fpol(a)/btrcen
|
||||
REAL(wp_), SAVE :: rmnm,rmxm,zmnm,zmxm
|
||||
REAL(wp_), SAVE :: zbinf,zbsup
|
||||
REAL(wp_), SAVE :: rup,zup,rlw,zlw
|
||||
! REAL(wp_), SAVE :: rup,zup,rlw,zlw
|
||||
|
||||
INTEGER, PARAMETER :: kspl=3,ksplp=kspl+1
|
||||
! === 2D spline psi(R,z), normalization and derivatives ==========
|
||||
@ -61,7 +61,7 @@ contains
|
||||
end if
|
||||
|
||||
! open G EQDSK file (see http://fusion.gat.com/efit/g_eqdsk.html)
|
||||
open(file=trim(filenm),status='old',unit=u)
|
||||
open(file=trim(filenm),status='old',action='read',unit=u)
|
||||
|
||||
! get size of main arrays and allocate them
|
||||
if (id==1) then
|
||||
@ -165,7 +165,7 @@ contains
|
||||
else
|
||||
u=get_free_unit()
|
||||
end if
|
||||
open(file=trim(filenm),status='old',unit=u)
|
||||
open(file=trim(filenm),status='old',action='read',unit=u)
|
||||
read(u,*) rr0m,zr0m,rpam
|
||||
read(u,*) b0
|
||||
read(u,*) q0,qa,alq
|
||||
@ -286,7 +286,7 @@ contains
|
||||
real(wp_), dimension(:), intent(in) :: rv,zv,psinr,fpol
|
||||
real(wp_), dimension(:,:), intent(in) :: psin
|
||||
real(wp_), intent(in) :: psiwbrad
|
||||
real(wp_), intent(inout) :: sspl,ssfp
|
||||
real(wp_), intent(in) :: sspl,ssfp
|
||||
real(wp_), intent(in), optional :: r0,rax,zax
|
||||
real(wp_), dimension(:), intent(in), optional :: rbnd,zbnd
|
||||
integer, intent(in), optional :: ixp
|
||||
@ -295,7 +295,8 @@ contains
|
||||
! local variables
|
||||
integer :: liwrk,lwrk,lw10,lw01,lw20,lw02,lw11,lwrkf
|
||||
integer :: nr,nz,nrest,nzest,npsest,nrz,npsi,nbnd,ibinf,ibsup
|
||||
real(wp_) :: fp,rax0,zax0,psinoptmp,psinxptmp,rbmin,rbmax,rbinf,rbsup,r1,z1
|
||||
real(wp_) :: sspln,fp,rax0,zax0,psinoptmp,psinxptmp
|
||||
real(wp_) :: rbmin,rbmax,rbinf,rbsup,r1,z1
|
||||
real(wp_), dimension(1) :: fpoli
|
||||
real(wp_), dimension(:), allocatable :: fvpsi,wf,wrk
|
||||
integer, dimension(:), allocatable :: iwrk
|
||||
@ -332,14 +333,15 @@ contains
|
||||
! reshape 2D psi array to 1D (transposed) array and compute spline coeffs
|
||||
allocate(fvpsi(nrz))
|
||||
fvpsi=reshape(transpose(psin),(/nrz/))
|
||||
sspln=sspl
|
||||
call regrid(iopt,nr,rv,nz,zv,fvpsi,rmnm,rmxm,zmnm,zmxm, &
|
||||
kspl,kspl,sspl,nrest,nzest,nsr,tr,nsz,tz,cceq,fp, &
|
||||
kspl,kspl,sspln,nrest,nzest,nsr,tr,nsz,tz,cceq,fp, &
|
||||
wrk(1:lwrk),lwrk,iwrk(1:liwrk),liwrk,ier)
|
||||
! if ier=-1 data are re-fitted using sspl=0
|
||||
if(ier==-1) then
|
||||
sspl=0.0_wp_
|
||||
sspln=0.0_wp_
|
||||
call regrid(iopt,nr,rv,nz,zv,fvpsi,rmnm,rmxm,zmnm,zmxm, &
|
||||
kspl,kspl,sspl,nrest,nzest,nsr,tr,nsz,tz,cceq,fp, &
|
||||
kspl,kspl,sspln,nrest,nzest,nsr,tr,nsz,tz,cceq,fp, &
|
||||
wrk(1:lwrk),lwrk,iwrk(1:liwrk),liwrk,ier)
|
||||
end if
|
||||
deallocate(fvpsi)
|
||||
@ -375,6 +377,7 @@ contains
|
||||
call splev(tfp,nsf,cfp,kspl,psinr(npsi:npsi),fpoli,1,ier)
|
||||
! set vacuum value used outside 0<=psin<=1 range
|
||||
fpolas=fpoli(1)
|
||||
sgnbphi=sign(one,fpolas)
|
||||
! free temporary arrays
|
||||
deallocate(wrk,iwrk,wf)
|
||||
!
|
||||
@ -667,6 +670,7 @@ contains
|
||||
|
||||
function fq(psin)
|
||||
use const_and_precisions, only : wp_
|
||||
use gray_params, only : iequil
|
||||
use simplespline, only :spli
|
||||
use utils, only : locate
|
||||
implicit none
|
||||
@ -675,12 +679,17 @@ contains
|
||||
real(wp_) :: fq
|
||||
! local variables
|
||||
integer :: i
|
||||
real(wp_) :: dps
|
||||
real(wp_) :: dps,rn
|
||||
|
||||
call locate(psinr,nq,psin,i)
|
||||
i=min(max(1,i),nq-1)
|
||||
dps=psin-psinr(i)
|
||||
fq=spli(cq,nq,i,dps)
|
||||
if (iequil<2) then
|
||||
rn=frhotor(sqrt(psin))
|
||||
fq=q0+(qa-q0)*rn**alq
|
||||
else
|
||||
call locate(psinr,nq,psin,i)
|
||||
i=min(max(1,i),nq-1)
|
||||
dps=psin-psinr(i)
|
||||
fq=spli(cq,nq,i,dps)
|
||||
end if
|
||||
end function fq
|
||||
|
||||
subroutine set_rhospl(rhop,rhot)
|
||||
@ -733,6 +742,27 @@ contains
|
||||
frhopol=spli(crhop,nrho,i,dr)
|
||||
end function frhopol
|
||||
|
||||
function frhopolv(rhot)
|
||||
use utils, only : locate
|
||||
use simplespline, only : spli
|
||||
implicit none
|
||||
! arguments
|
||||
real(wp_), dimension(:), intent(in) :: rhot
|
||||
real(wp_), dimension(size(rhot)) :: frhopolv
|
||||
! local variables
|
||||
integer :: i,i0,j
|
||||
real(wp_) :: dr
|
||||
|
||||
i0=1
|
||||
do j=1,size(rhot)
|
||||
call locate(rhotr(i0:),nrho-i0+1,rhot(j),i)
|
||||
i=min(max(1,i),nrho-i0)+i0-1
|
||||
dr=rhot(j)-rhotr(i)
|
||||
frhopolv(j)=spli(crhop,nrho,i,dr)
|
||||
i0=i
|
||||
end do
|
||||
end function frhopolv
|
||||
|
||||
function frhotor(rhop)
|
||||
use utils, only : locate
|
||||
use simplespline, only : spli
|
||||
@ -888,6 +918,7 @@ contains
|
||||
q0=qax
|
||||
qa=q1
|
||||
alq=qexp
|
||||
sgnbphi=sign(one,bax)
|
||||
|
||||
if (present(n)) then
|
||||
nq=n
|
||||
@ -927,7 +958,6 @@ contains
|
||||
real(wp_), intent(out), optional :: psinv,fpolv,dfpv,dpsidr,dpsidz, &
|
||||
ddpsidrr,ddpsidzz,ddpsidrz
|
||||
! local variables
|
||||
integer :: sgn
|
||||
real(wp_) :: cst,dpsidrp,d2psidrp,dqq,qq,rn,rpm,snt,rhop,rhot
|
||||
! real(wp_) :: frhopol
|
||||
|
||||
@ -948,21 +978,21 @@ contains
|
||||
rhot=rn
|
||||
if(rn <= 1.0_wp_) then
|
||||
rhop=frhopol(rhot)
|
||||
psinv=rhop*rhop
|
||||
psinv=rhop**2
|
||||
else
|
||||
psinv=1.0_wp_+btaxis*aminor**2/2.0_wp_/psia/qa*(rn*rn-1.0_wp_)
|
||||
psinv=1.0_wp_+btaxis/(2.0_wp_*psia*qa)*(rpm**2-aminor**2)
|
||||
rhop=sqrt(psinv)
|
||||
end if
|
||||
end if
|
||||
|
||||
if(rn <= 1.0_wp_) then
|
||||
qq=q0+(qa-q0)*rn**alq
|
||||
dpsidrp=-btaxis*aminor*rn/qq
|
||||
dpsidrp=btaxis*aminor*rn/qq
|
||||
dqq=alq*(qa-q0)*rn**(alq-1.0_wp_)
|
||||
d2psidrp=-btaxis*(1.0_wp_-rn*dqq/qq)/qq
|
||||
d2psidrp=btaxis/qq*(1.0_wp_-rn*dqq/qq)
|
||||
else
|
||||
dpsidrp=-btaxis*aminor/qa*rn
|
||||
d2psidrp=-btaxis/qa
|
||||
dpsidrp=btaxis*rpm/qa
|
||||
d2psidrp=btaxis/qa
|
||||
end if
|
||||
|
||||
if(present(fpolv)) fpolv=btaxis*rmaxis
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
208
src/gray_params.f90
Normal file
208
src/gray_params.f90
Normal file
@ -0,0 +1,208 @@
|
||||
module gray_params
|
||||
use const_and_precisions, only : wp_
|
||||
implicit none
|
||||
integer, parameter :: lenfnm=256
|
||||
|
||||
type antctrl_type
|
||||
real(wp_) :: alpha, beta, power
|
||||
real(wp_) :: psi, chi
|
||||
integer :: iox
|
||||
integer :: ibeam
|
||||
character(len=lenfnm) :: filenm
|
||||
end type antctrl_type
|
||||
|
||||
type eqparam_type
|
||||
real(wp_) :: ssplps, ssplf, factb
|
||||
integer :: sgnb, sgni, ixp
|
||||
integer :: iequil, icocos, ipsinorm, idesc, ifreefmt
|
||||
character(len=lenfnm) :: filenm
|
||||
end type eqparam_type
|
||||
|
||||
type prfparam_type
|
||||
real(wp_) :: psnbnd, sspld, factne, factte
|
||||
integer :: iscal, irho !, icrho, icte, icne, iczf
|
||||
integer :: iprof
|
||||
character(len=lenfnm) :: filenm
|
||||
end type prfparam_type
|
||||
|
||||
type rtrparam_type
|
||||
real(wp_) :: rwmax, dst
|
||||
integer :: nrayr, nrayth, nstep
|
||||
integer :: igrad, idst, ipass, ipol
|
||||
end type rtrparam_type
|
||||
|
||||
type hcdparam_type
|
||||
integer :: iwarm, ilarm, imx, ieccd
|
||||
end type hcdparam_type
|
||||
|
||||
type outparam_type
|
||||
integer :: ipec, nrho, istpr, istpl
|
||||
end type outparam_type
|
||||
|
||||
|
||||
integer, save :: iequil,iprof,ipol
|
||||
integer, save :: iwarm,ilarm,imx,ieccd
|
||||
integer, save :: igrad,idst,ipass
|
||||
integer, save :: istpr0,istpl0
|
||||
integer, save :: ipec,nnd
|
||||
|
||||
contains
|
||||
|
||||
subroutine read_inputs(filenm,antctrl,eqparam,rwall,prfparam,outparam,unit)
|
||||
use const_and_precisions, only : wp_
|
||||
use utils, only : get_free_unit
|
||||
implicit none
|
||||
! arguments
|
||||
character(len=*), intent(in) :: filenm
|
||||
type(antctrl_type), intent(out) :: antctrl
|
||||
type(eqparam_type), intent(out) :: eqparam
|
||||
real(wp_), intent(out) :: rwall
|
||||
type(prfparam_type), intent(out) :: prfparam
|
||||
type(outparam_type), intent(out) :: outparam
|
||||
integer, intent(in), optional :: unit
|
||||
! local variables
|
||||
integer :: u
|
||||
|
||||
if (present(unit)) then
|
||||
u=unit
|
||||
else
|
||||
u = get_free_unit()
|
||||
end if
|
||||
open(u,file=filenm,status= 'old',action='read')
|
||||
|
||||
! alpha0, beta0 (cartesian) launching angles
|
||||
read(u,*) antctrl%alpha, antctrl%beta
|
||||
! p0mw injected power (MW)
|
||||
read(u,*) antctrl%power
|
||||
! abs(iox)=1/2 OM/XM
|
||||
! psipol0,chipol0 polarization angles at the antenna (if iox<0)
|
||||
read(u,*) antctrl%iox, antctrl%psi, antctrl%chi
|
||||
|
||||
! ibeam=0 :read data for beam as above
|
||||
! ibeam=1 :read data from file simple astigmatic beam
|
||||
! ibeam=2 :read data from file general astigmatic beam
|
||||
read(u,*) antctrl%ibeam
|
||||
read(u,*) antctrl%filenm
|
||||
|
||||
! iequil=0 :vacuum
|
||||
! iequil=1 :analytical equilibrium
|
||||
! iequil=2 :read eqdsk
|
||||
read(u,*) eqparam%iequil
|
||||
read(u,*) eqparam%filenm
|
||||
! icocos :index for equilibrium from COCOS - O. Sauter Feb 2012
|
||||
! ipsinorm :0 standard EQDSK format, 1 format Portone summer 2004
|
||||
read(u,*) eqparam%icocos, eqparam%ipsinorm, eqparam%idesc, eqparam%ifreefmt
|
||||
! ixp=0,-1,+1 : no X point , bottom/up X point
|
||||
! ssplps : spline parameter for psi interpolation
|
||||
read(u,*) eqparam%ixp, eqparam%ssplps !, eqparam%ssplf
|
||||
eqparam%ssplf=0.01_wp_
|
||||
! signum of toroidal B and I
|
||||
! factb factor for magnetic field (only for numerical equil)
|
||||
! scaling adopted: beta=const, qpsi=const, nustar=const
|
||||
read(u,*) eqparam%sgnb, eqparam%sgni, eqparam%factb
|
||||
|
||||
read(u,*) rwall
|
||||
|
||||
! iprof=0 :analytical density and temp. profiles
|
||||
! iprof>0 :numerical density and temp. profiles
|
||||
read(u,*) prfparam%iprof, prfparam%irho ! irho=0,1,2 -> num profiles vs rhot,rhop,psin
|
||||
read(u,*) prfparam%filenm
|
||||
! psbnd value of psi ( > 1 ) of density boundary
|
||||
read(u,*) prfparam%psnbnd !, prfparam%sspld
|
||||
prfparam%sspld=0.001_wp_
|
||||
! iscal ne Te scaling 0: nustar=const, 1: n_greenw=const; 2 no rescaling
|
||||
! factT factn factor for Te&ne scaling
|
||||
read(u,*) prfparam%factte, prfparam%factne, prfparam%iscal
|
||||
|
||||
! ipec=0/1 :pec profiles grid in psi/rhop
|
||||
! nrho :number of grid steps for pec profiles +1
|
||||
read(u,*) outparam%ipec, outparam%nrho
|
||||
! istpr0 projection step = dsdt*istprj
|
||||
! istpl0 plot step = dsdt*istpl
|
||||
read(u,*) outparam%istpr, outparam%istpl
|
||||
close(u)
|
||||
end subroutine read_inputs
|
||||
|
||||
subroutine read_params(filenm,rtrparam,hcdparam,unit)
|
||||
use utils, only : get_free_unit
|
||||
implicit none
|
||||
! arguments
|
||||
character(len=*), intent(in) :: filenm
|
||||
type(rtrparam_type), intent(out) :: rtrparam
|
||||
type(hcdparam_type), intent(out) :: hcdparam
|
||||
integer, intent(in), optional :: unit
|
||||
! local variables
|
||||
integer :: u
|
||||
|
||||
if (present(unit)) then
|
||||
u=unit
|
||||
else
|
||||
u = get_free_unit()
|
||||
end if
|
||||
open(u,file=filenm,status= 'old',action='read')
|
||||
|
||||
! nrayr number of rays in radial direction
|
||||
! nrayth number of rays in angular direction
|
||||
! rwmax normalized maximum radius of beam power
|
||||
! rwmax=1 -> last ray at radius = waist
|
||||
read(u,*) rtrparam%nrayr, rtrparam%nrayth, rtrparam%rwmax
|
||||
! igrad=0 optical ray-tracing, initial conditions as for beam
|
||||
! igrad=1 quasi-optical ray-tracing
|
||||
! igrad=-1 ray-tracing, init. condit.
|
||||
! from center of mirror and with angular spread
|
||||
! ipass=1/2 1 or 2 passes into plasma
|
||||
! ipol=0 compute mode polarization at antenna, ipol=1 use polariz angles
|
||||
read(u,*) rtrparam%igrad, rtrparam%ipass, rtrparam%ipol
|
||||
! dst integration step
|
||||
! nstep maximum number of integration steps
|
||||
! idst=0/1/2 0 integration in s, 1 integr. in ct, 2 integr. in Sr
|
||||
read(u,*) rtrparam%dst, rtrparam%nstep, rtrparam%idst
|
||||
|
||||
! iwarm=0 :no absorption and cd
|
||||
! iwarm=1 :weakly relativistic absorption
|
||||
! iwarm=2 :relativistic absorption, n<1 asymptotic expansion
|
||||
! iwarm=3 :relativistic absorption, numerical integration
|
||||
! ilarm :order of larmor expansion
|
||||
! imx :max n of iterations in dispersion, imx<0 uses 1st
|
||||
! iteration in case of failure after |imx| iterations
|
||||
read(u,*) hcdparam%iwarm,hcdparam%ilarm,hcdparam%imx
|
||||
|
||||
! ieccd 0/1 NO/YES ECCD calculation ieccd>0 different CD models
|
||||
read(u,*) hcdparam%ieccd
|
||||
close(u)
|
||||
end subroutine read_params
|
||||
|
||||
subroutine set_codepar(eqparam,prfparam,outparam,rtrparam,hcdparam)
|
||||
implicit none
|
||||
type(eqparam_type), intent(in) :: eqparam
|
||||
type(prfparam_type), intent(in) :: prfparam
|
||||
type(outparam_type), intent(in) :: outparam
|
||||
type(rtrparam_type), intent(in) :: rtrparam
|
||||
type(hcdparam_type), intent(in) :: hcdparam
|
||||
|
||||
iequil=eqparam%iequil
|
||||
iprof=prfparam%iprof
|
||||
|
||||
ipec=outparam%ipec
|
||||
nnd=outparam%nrho
|
||||
istpr0=outparam%istpr
|
||||
istpl0=outparam%istpl
|
||||
|
||||
ipol=rtrparam%ipol
|
||||
igrad=rtrparam%igrad
|
||||
idst=rtrparam%idst
|
||||
ipass=rtrparam%ipass
|
||||
if (rtrparam%nrayr<5) then
|
||||
igrad=0
|
||||
print*,' nrayr < 5 ! => OPTICAL CASE ONLY'
|
||||
print*,' '
|
||||
end if
|
||||
|
||||
iwarm=hcdparam%iwarm
|
||||
ilarm=hcdparam%ilarm
|
||||
imx=hcdparam%imx
|
||||
ieccd=hcdparam%ieccd
|
||||
|
||||
end subroutine set_codepar
|
||||
|
||||
end module gray_params
|
||||
131
src/graycore.f90
Normal file
131
src/graycore.f90
Normal file
@ -0,0 +1,131 @@
|
||||
module graycore
|
||||
use const_and_precisions, only : wp_
|
||||
implicit none
|
||||
|
||||
contains
|
||||
|
||||
subroutine gray(rv,zv,psin,psia,psinr,fpol,qpsi,rvac,rax,zax,rbnd,zbnd,eqp, &
|
||||
psrad,terad,derad,zfc,prfp, rlim,zlim, &
|
||||
p0,fghz,alpha0,beta0,x0,y0,z0,w1,w2,ri1,ri2,phiw,phir,iox0, &
|
||||
psipol0,chipol0, dpdv,jcd,pec,icd, outp,rtrp,hcdp,ierr)
|
||||
use coreprofiles, only : set_prfan, set_prfspl
|
||||
use gray_params, only : eqparam_type, prfparam_type, outparam_type, &
|
||||
rtrparam_type, hcdparam_type, set_codepar, igrad, iequil, iprof
|
||||
use beams, only : read_beam0, read_beam1, launchangles2n, xgygcoeff
|
||||
use equilibrium, only : set_equian, set_eqspl, setqphi_num, set_rhospl
|
||||
use beamdata, only : init_rtr, dealloc_beam, nstep, dst
|
||||
use reflections, only : set_lim
|
||||
implicit none
|
||||
type(eqparam_type), intent(in) :: eqp
|
||||
type(prfparam_type), intent(in) :: prfp
|
||||
type(outparam_type), intent(in) :: outp
|
||||
type(rtrparam_type), intent(in) :: rtrp
|
||||
type(hcdparam_type), intent(in) :: hcdp
|
||||
real(wp_), dimension(:), allocatable, intent(in) :: psrad, terad, derad, zfc
|
||||
real(wp_), dimension(:), allocatable, intent(in) :: rv, zv, psinr, fpol, qpsi
|
||||
real(wp_), dimension(:), allocatable, intent(in) :: rbnd, zbnd, rlim, zlim
|
||||
real(wp_), dimension(:,:), allocatable, intent(in) :: psin
|
||||
real(wp_), intent(in) :: psia, rvac, rax, zax
|
||||
integer, intent(in) :: iox0
|
||||
real(wp_), intent(in) :: p0, fghz, psipol0, chipol0
|
||||
real(wp_), intent(in) :: alpha0,beta0, x0,y0,z0, w1,w2, ri1,ri2, phiw,phir
|
||||
real(wp_), intent(out) :: pec,icd
|
||||
real(wp_), dimension(:), intent(out) :: dpdv,jcd
|
||||
integer, intent(out) :: ierr
|
||||
real(wp_), dimension(:), allocatable :: rhotn
|
||||
|
||||
real(wp_) :: sox,ak0,bres,xgcn,anx0,any0,anz0
|
||||
integer :: i,iox,istop,index_rt
|
||||
|
||||
integer :: istep
|
||||
real(wp_) :: st
|
||||
common/ss/st
|
||||
common/istep/istep
|
||||
|
||||
! ======= set environment BEGIN ======
|
||||
call set_codepar(eqp,prfp,outp,rtrp,hcdp)
|
||||
|
||||
call set_lim(rlim,zlim)
|
||||
|
||||
if(iequil<2) then
|
||||
call set_equian(rv(1),zv(1),rv(2), fpol(1)/rv(1), qpsi(1),qpsi(2),qpsi(3))
|
||||
call flux_average_an
|
||||
else
|
||||
call set_eqspl(rv,zv,psin, psia, psinr,fpol, eqp%ssplps,eqp%ssplf, rvac, &
|
||||
rax,zax, rbnd,zbnd, eqp%ixp)
|
||||
! compute rho_pol/rho_tor mapping
|
||||
allocate(rhotn(size(qpsi)))
|
||||
call setqphi_num(psinr,abs(qpsi),abs(psia),rhotn)
|
||||
call set_rhospl(sqrt(psinr),rhotn)
|
||||
deallocate(rhotn)
|
||||
! compute flux surface averaged quantities
|
||||
call flux_average ! requires frhotor for dadrhot,dvdrhot
|
||||
! print psi surface for q=1.5 and q=2
|
||||
call surfq(psinr,qpsi,size(qpsi),1.5_wp_)
|
||||
call surfq(psinr,qpsi,size(qpsi),2.0_wp_)
|
||||
end if
|
||||
|
||||
if(iprof==0) then
|
||||
call set_prfan(terad,derad,zfc)
|
||||
else
|
||||
call set_prfspl(psrad, terad, derad, zfc, prfp%sspld, prfp%psnbnd)
|
||||
end if
|
||||
|
||||
call xgygcoeff(fghz,ak0,bres,xgcn)
|
||||
call launchangles2n(alpha0,beta0,x0,y0,z0,anx0,any0,anz0)
|
||||
call init_rtr(rtrp)
|
||||
|
||||
! ======= set environment END ======
|
||||
|
||||
! ======= pre-proc prints BEGIN ======
|
||||
! print Btot=Bres
|
||||
! print ne, Te, q, Jphi versus psi, rhop, rhot
|
||||
if (iequil==1) then
|
||||
call bres_anal(bres)
|
||||
call print_prof_an
|
||||
else
|
||||
call bfield_res(rv,zv,size(rv),size(zv),bres)
|
||||
call print_prof
|
||||
end if
|
||||
! ======= pre-proc prints END ======
|
||||
|
||||
! ======= main loop BEGIN ======
|
||||
iox=iox0
|
||||
sox=-1.0_wp_
|
||||
if(iox.eq.2) sox=1.0_wp_
|
||||
index_rt=1
|
||||
call prfile
|
||||
call paraminit
|
||||
call vectinit
|
||||
if(igrad==0) then
|
||||
call ic_rt(x0,y0,z0,anx0,any0,anz0,ak0,xgcn,bres, &
|
||||
w1,w2,ri1,ri2,phiw,phir,sox,psipol0,chipol0)
|
||||
else
|
||||
call ic_gb(x0,y0,z0,anx0,any0,anz0,ak0,xgcn,bres, &
|
||||
w1,w2,ri1,ri2,phiw,phir,sox,psipol0,chipol0)
|
||||
end if
|
||||
! if(ierr==0) return
|
||||
! beam/ray propagation
|
||||
! st0=0.0_wp_
|
||||
! if(index_rt.gt.1) st0=strfl11
|
||||
do i=1,nstep
|
||||
istep=i
|
||||
st=i*dst !+st0
|
||||
! advance one step
|
||||
call rkint4(sox,xgcn,bres)
|
||||
! calculations after one step:
|
||||
call after_onestep(p0,sox,ak0,xgcn,bres,i,istop,ierr)
|
||||
if(istop.eq.1) exit
|
||||
end do
|
||||
! postprocessing
|
||||
call after_gray_integration(pec,icd,dpdv,jcd)
|
||||
|
||||
! ======= main loop END ======
|
||||
|
||||
! ======= free memory BEGIN ======
|
||||
call dealloc_beam
|
||||
! call unset...
|
||||
! ======= free memory END ======
|
||||
end subroutine gray
|
||||
|
||||
end module graycore
|
||||
@ -1,12 +0,0 @@
|
||||
module graydata_anequil
|
||||
use const_and_precisions, only : wp_
|
||||
implicit none
|
||||
|
||||
real(wp_), save :: dens0,aln1,aln2
|
||||
real(wp_), save :: te0,dte0,alt1,alt2
|
||||
real(wp_), save :: rr0,zr0,rpa
|
||||
real(wp_), save :: b0,rr0m,zr0m,rpam
|
||||
real(wp_), save :: q0,qa,alq
|
||||
real(wp_), save :: zeffan
|
||||
|
||||
end module graydata_anequil
|
||||
@ -1,14 +0,0 @@
|
||||
module graydata_flags
|
||||
use const_and_precisions, only : wp_
|
||||
implicit none
|
||||
|
||||
character*255, save :: filenmeqq,filenmprf,filenmbm
|
||||
real(wp_), save :: sspl, dst
|
||||
integer, save :: ibeam,iequil,ixp,iprof
|
||||
integer, save :: iwarm,ilarm,imx,ieccd,ipec,idst
|
||||
integer, save :: igrad,ipass
|
||||
integer, save :: ipsinorm,iscal,icocos
|
||||
integer, save :: nnd,istpr0,istpl0,ipol
|
||||
integer, save :: neqdsk,nprof
|
||||
|
||||
end module graydata_flags
|
||||
@ -1,10 +0,0 @@
|
||||
module graydata_par
|
||||
use const_and_precisions, only : wp_
|
||||
implicit none
|
||||
|
||||
real(wp_), save :: rwmax,rwallm
|
||||
real(wp_), save :: psipol0,chipol0
|
||||
real(wp_), save :: factb,factt,factn
|
||||
real(wp_), save :: sgnbphi,sgniphi
|
||||
|
||||
end module graydata_par
|
||||
126
src/main.f90
Normal file
126
src/main.f90
Normal file
@ -0,0 +1,126 @@
|
||||
program gray_main
|
||||
use const_and_precisions, only : wp_,one
|
||||
use graycore, only : gray
|
||||
use gray_params, only : read_inputs,read_params, antctrl_type,eqparam_type, &
|
||||
prfparam_type,outparam_type,rtrparam_type,hcdparam_type
|
||||
use beams, only : read_beam0, read_beam1
|
||||
use equilibrium, only : read_equil_an,read_eqdsk,change_cocos,eq_scal, &
|
||||
set_rhospl,setqphi_num,frhopolv
|
||||
use coreprofiles, only : read_profiles_an,read_profiles,tene_scal
|
||||
use reflections, only : range2rect
|
||||
implicit none
|
||||
type(antctrl_type) :: antp
|
||||
type(eqparam_type) :: eqp
|
||||
type(prfparam_type) :: prfp
|
||||
type(outparam_type) :: outp
|
||||
type(rtrparam_type) :: rtrp
|
||||
type(hcdparam_type) :: hcdp
|
||||
|
||||
real(wp_), dimension(:), allocatable :: psrad, terad, derad, zfc
|
||||
real(wp_), dimension(:), allocatable :: rv, zv, psinr, fpol, qpsi
|
||||
real(wp_), dimension(:), allocatable :: rbnd, zbnd, rlim, zlim
|
||||
real(wp_), dimension(:,:), allocatable :: psin
|
||||
real(wp_) :: psia, rvac, rax, zax
|
||||
integer :: iox0
|
||||
real(wp_) :: p0mw, fghz, psipol0, chipol0
|
||||
real(wp_) :: alpha0, beta0, x0, y0, z0, w1, w2, ri1, ri2, phiw, phir
|
||||
|
||||
real(wp_) :: pec,icd
|
||||
|
||||
integer :: ierr
|
||||
real(wp_), dimension(:), allocatable :: xrad, rhot, dpdv, jcd
|
||||
real(wp_) :: rwallm, rmxm, r0m, z0m, dzmx
|
||||
|
||||
! ======= read parameters BEGIN =======
|
||||
call read_inputs('graynew.data',antp,eqp,rwallm,prfp,outp)
|
||||
call read_params('gray_params.data',rtrp,hcdp)
|
||||
! ======= read parameters END =======
|
||||
|
||||
! ======= read input data BEGIN =======
|
||||
!------------ equilibrium ------------
|
||||
if(eqp%iequil<2) then
|
||||
call read_equil_an(eqp%filenm, rv, zv, fpol, qpsi)
|
||||
! psia sign set to give the correct sign to Iphi (COCOS=3: psia<0 for Iphi>0)
|
||||
psia = sign(one,qpsi(2)*fpol(1))
|
||||
else
|
||||
call read_eqdsk(eqp%filenm, rv,zv,psin, psia, psinr,fpol,qpsi, rvac, &
|
||||
rax,zax, rbnd,zbnd, rlim,zlim, eqp%ipsinorm,eqp%idesc,eqp%ifreefmt)
|
||||
call change_cocos(psia, fpol, qpsi, eqp%icocos, 3)
|
||||
end if
|
||||
! re-scale B/I and/or force signs. If sgn=0 on input, set to fpol/-psia signs on output
|
||||
call eq_scal(psia, fpol, eqp%sgni, eqp%sgnb, eqp%factb)
|
||||
qpsi(1) = sign(qpsi(1),qpsi(1)*qpsi(2)*psia*fpol(1))
|
||||
qpsi(2) = sign(qpsi(2),psia*fpol(1))
|
||||
!------------- profiles -------------
|
||||
if(prfp%iprof==0) then
|
||||
call read_profiles_an(prfp%filenm, terad, derad, zfc)
|
||||
else
|
||||
call read_profiles(prfp%filenm, xrad, terad, derad, zfc)
|
||||
allocate(psrad(size(xrad)))
|
||||
if(prfp%irho==0) then
|
||||
call setqphi_num(psinr,qpsi,psia,rhot)
|
||||
call set_rhospl(sqrt(psinr),rhot)
|
||||
psrad=frhopolv(xrad)
|
||||
else if(prfp%irho == 1) then
|
||||
psrad=xrad**2
|
||||
else
|
||||
psrad=xrad
|
||||
end if
|
||||
deallocate(xrad)
|
||||
end if
|
||||
! re-scale input data
|
||||
call tene_scal(terad,derad,prfp%factte,prfp%factne,eqp%factb,prfp%iscal,prfp%iprof)
|
||||
!------------- antenna --------------
|
||||
! interpolate beam table if antctrl%ibeam>0
|
||||
if(antp%ibeam>0) then
|
||||
call read_beam1(antp%filenm,antp%alpha,antp%beta,fghz,x0,y0,z0,w1,w2,ri1,ri2,phiw,phir)
|
||||
else
|
||||
call read_beam0(antp%filenm,antp%alpha,antp%beta,fghz,x0,y0,z0,w1,w2,ri1,ri2,phiw,phir)
|
||||
end if
|
||||
alpha0=antp%alpha
|
||||
beta0=antp%beta
|
||||
p0mw=antp%power
|
||||
psipol0=antp%psi
|
||||
chipol0=antp%chi
|
||||
iox0=antp%iox
|
||||
!--------------- wall ---------------
|
||||
! set simple limiter if not read from EQDSK
|
||||
! need to clean up...
|
||||
r0m=sqrt(x0**2+y0**2)*0.01_wp_
|
||||
dzmx=rtrp%dst*rtrp%nstep*0.01_wp_
|
||||
z0m=z0*0.01_wp_
|
||||
if (.not.allocated(rlim).or.rtrp%ipass<0) then
|
||||
rtrp%ipass=abs(rtrp%ipass)
|
||||
if(eqp%iequil<2) then
|
||||
rmxm=(rv(1)+rv(2))*0.01_wp_
|
||||
else
|
||||
rmxm=rv(size(rv))
|
||||
end if
|
||||
call range2rect(rwallm,max(r0m,rmxm),z0m-dzmx,z0m+dzmx,rlim,zlim)
|
||||
end if
|
||||
! ======= read input data END =======
|
||||
|
||||
! ========================= MAIN SUBROUTINE CALL =========================
|
||||
allocate(dpdv(outp%nrho),jcd(outp%nrho))
|
||||
call gray(rv,zv,psin,psia,psinr,fpol,qpsi,rvac,rax,zax,rbnd,zbnd,eqp, &
|
||||
psrad,terad,derad,zfc,prfp, rlim,zlim, &
|
||||
p0mw,fghz,alpha0,beta0,x0,y0,z0,w1,w2,ri1,ri2,phiw,phir,iox0, &
|
||||
psipol0,chipol0, dpdv,jcd,pec,icd, outp,rtrp,hcdp,ierr)
|
||||
! ========================================================================
|
||||
|
||||
! ======= control prints BEGIN =======
|
||||
if(ierr/=0) print*,' IERR = ', ierr
|
||||
print*,' '
|
||||
print*,'Pabs (MW), Icd (kA) = ', pec,icd*1.0e3_wp_
|
||||
! ======= control prints END =======
|
||||
|
||||
! ======= free memory BEGIN =======
|
||||
if(allocated(psrad)) deallocate(psrad)
|
||||
if(allocated(terad)) deallocate(terad, derad, zfc)
|
||||
if(allocated(rv)) deallocate(rv, zv, fpol, qpsi)
|
||||
if(allocated(psin)) deallocate(psin, psinr)
|
||||
if(allocated(rbnd)) deallocate(rbnd,zbnd)
|
||||
if(allocated(rlim)) deallocate(rlim,zlim)
|
||||
if(allocated(dpdv)) deallocate(dpdv, jcd)
|
||||
! ======= free memory END ======
|
||||
end program gray_main
|
||||
@ -4,12 +4,13 @@ module reflections
|
||||
|
||||
! === 1D array limiter Rlim_i, Zlim_i
|
||||
integer, public, save :: nlim
|
||||
real(wp_), public, save :: rwallm
|
||||
real(wp_), public, dimension(:), allocatable, save :: rlim,zlim
|
||||
|
||||
private
|
||||
public :: reflect,inters_linewall,inside
|
||||
public :: linecone_coord,interssegm_coord,interssegm
|
||||
public :: alloc_lim,wall_refl
|
||||
public :: alloc_lim,wall_refl,range2rect,set_lim
|
||||
|
||||
contains
|
||||
|
||||
@ -313,7 +314,30 @@ subroutine wall_refl(xv,anv,ext,eyt,xvrfl,anvrfl,extr,eytr,walln,irfl)
|
||||
extr=dot_product(vv1,evrfl)
|
||||
eytr=dot_product(vv2,evrfl)
|
||||
eztr=dot_product(vv3,evrfl)
|
||||
end
|
||||
end subroutine wall_refl
|
||||
|
||||
subroutine range2rect(xmin,xmax,ymin,ymax,xv,yv)
|
||||
implicit none
|
||||
real(wp_), intent(in) :: xmin,xmax,ymin,ymax
|
||||
real(wp_), intent(out), dimension(:), allocatable :: xv,yv
|
||||
if (allocated(xv)) deallocate(xv)
|
||||
if (allocated(yv)) deallocate(yv)
|
||||
allocate(xv(5),yv(5))
|
||||
xv=(/xmin,xmax,xmax,xmin,xmin/)
|
||||
yv=(/ymin,ymin,ymax,ymax,ymin/)
|
||||
end subroutine range2rect
|
||||
|
||||
subroutine set_lim(rv,zv)
|
||||
implicit none
|
||||
real(wp_), intent(in), dimension(:) :: rv,zv
|
||||
if (allocated(rlim)) deallocate(rlim)
|
||||
if (allocated(zlim)) deallocate(zlim)
|
||||
nlim=size(rv)
|
||||
allocate(rlim(nlim),zlim(nlim))
|
||||
rlim=rv
|
||||
zlim=zv
|
||||
rwallm=minval(rlim)
|
||||
end subroutine set_lim
|
||||
|
||||
end module reflections
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user