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

started reorganization of interp_eqprof (equilibrium) and coreprofiles modules

Browse Source
This commit is contained in:
Lorenzo Figini 2015-07-13 14:50:41 +00:00
parent 900a51a08c
commit 321d870431
5 changed files with 279 additions and 609 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Makefile
View File

@ -3,8 +3,8 @@ EXE=gray
# Objects list
MAINOBJ=gray.o
OTHOBJ=conical.o const_and_precisions.o dierckx.o dispersion.o eccd.o eierf.o \
graydata_anequil.o graydata_flags.o graydata_par.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 \
interp_eqprof.o magsurf_data.o math.o minpack.o numint.o quadpack.o \
reflections.o simplespline.o utils.o beamdata.o
@ -25,11 +25,13 @@ $(EXE): $(MAINOBJ) $(OTHOBJ)
$(FC) $(FFLAGS) -o $@ $^
# Dependencies on modules
gray.o: const_and_precisions.o dierckx.o dispersion.o eccd.o \
gray.o: const_and_precisions.o coreprofiles.o dierckx.o dispersion.o eccd.o \
graydata_anequil.o graydata_flags.o graydata_par.o \
interp_eqprof.o magsurf_data.o math.o minpack.o numint.o quadpack.o \
reflections.o simplespline.o utils.o beamdata.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
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

7
src/eccd.f90
View File

@ -99,11 +99,6 @@ module eccd
contains
subroutine initeccd(ieccd)
implicit none
integer, intent(in) :: ieccd
end subroutine initeccd
subroutine setcdcoeff_notrap(zeff,cst2,eccdpar)
implicit none
real(wp_), intent(in) :: zeff
@ -151,7 +146,6 @@ contains
real(wp_), intent(in) :: zeff,rbx,fc,amu,rhop
real(wp_), intent(out) :: cst2
real(wp_), dimension(:), allocatable, intent(out) :: eccdpar
real(wp_) :: alams,pa,fp0s
real(wp_), dimension(nlmt) :: chlm
integer :: nlm,ierr,npar
@ -424,7 +418,6 @@ contains
real(wp_) :: upl,fjch
real(wp_), dimension(npar) :: extrapar
! local variables
integer :: nhn
real(wp_) :: anpl,anprre,ygn,zeff,rb,alams,pa,fp0s, &
upr2,gam,u2,u,z5,xi,xib,xibi,fu2b,fu2,gu,gg,dgg,alam,fp0, &
dfp0,fh,dfhl,eta

678
src/gray.f
View File

File diff suppressed because it is too large Load Diff

2
src/graydata_par.f90
View File

@ -4,7 +4,7 @@ module graydata_par
real(wp_), save :: rwmax,rwallm
real(wp_), save :: psipol0,chipol0
real(wp_), save :: factb,factt,factn,psdbnd
real(wp_), save :: factb,factt,factn
real(wp_), save :: sgnbphi,sgniphi
end module graydata_par

183
src/interp_eqprof.f90
View File

@ -3,29 +3,53 @@ module interp_eqprof
implicit none
! equidata
INTEGER, SAVE :: nlim,nr,nz,nbbbs,nsrt,nszt,nsft
REAL(wp_), SAVE :: psia,psiant,psinop,btrcen,rcen
REAL(wp_), SAVE :: btaxis,rmaxis,zmaxis,rmnm,rmxm,zmnm,zmxm,dr,dz
REAL(wp_), SAVE :: zbmin,zbmax,fpolas,phitedge,rrtor,rup,zup,rlw,zlw !rrtor non usato, solo in equidata
REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: tr,tz,tfp
REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: cceq,cfp
REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: cceq01,cceq10,cceq20,cceq02,cceq11
REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: psinr,rhopnr,qpsi,rv,zv
REAL(wp_), DIMENSION(:,:), ALLOCATABLE, SAVE :: psin,psi,btotal,crhot,cq
REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: rlim,zlim,rbbbs,zbbbs
! === 2D array psi(R,z) ==========================================
INTEGER, SAVE :: nr,nz
REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: rv,zv
REAL(wp_), DIMENSION(:,:), ALLOCATABLE, SAVE :: psin
! === 1D array Fpol(psi), q(psi), rhotor(psi) ====================
!INTEGER, SAVE :: npsieq
REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: psinr,rhopnr,fpol,qpsi
! profdata
INTEGER, SAVE :: npp,nsfd
REAL(wp_), SAVE :: psnpp,denpp,ddenpp,d2denpp
REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: psrad,derad,terad,zfc,tfn,cfn
REAL(wp_), DIMENSION(:,:), ALLOCATABLE, SAVE :: ct,cz
! === 1D array plasma boundary Rbnd_i, Zbnd_i ====================
INTEGER, SAVE :: nbbbs
REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: rbbbs,zbbbs
! === 1D array limiter Rlim_i, Zlim_i ==> move in wall/reflections
INTEGER, SAVE :: nlim
REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: rlim,zlim
REAL(wp_), SAVE :: btaxis,rmaxis,zmaxis
REAL(wp_), SAVE :: rmnm,rmxm,zmnm,zmxm,dr,dz
REAL(wp_), SAVE :: zbmin,zbmax
REAL(wp_), SAVE :: phitedge
REAL(wp_), SAVE :: rup,zup,rlw,zlw
REAL(wp_), SAVE :: rcen,btrcen ! rcen unused, btrcen used only for Jcd_ASTRA def.
! === 2D spline psi(R,z), normalization and derivatives ==========
INTEGER, SAVE :: nrest, nzest, lw10, lw01, lw20, lw02, lw11
INTEGER :: nsr,nsz
REAL(wp_), SAVE :: psia, psiant, psinop
REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: tr,tz
REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: cceq, cceq01, cceq10, &
cceq20, cceq02, cceq11
! === 1D spline Fpol(psi) ========================================
! INTEGER, SAVE :: npsiest
INTEGER, SAVE :: nsf
REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: tfp,cfp
REAL(wp_), SAVE :: fpolas
! === 1D spline rhot(rhop), rhop(rhot), q(psi) ===================
! computed on psinr,rhopnr [,rhotnr] arrays
REAL(wp_), DIMENSION(:,:), ALLOCATABLE, SAVE :: crhot,cq
! !!! 2D B(R,z) array. Computed in bfield_res,
! !!! used by cniteq to plot resonant field contour lines.
REAL(wp_), DIMENSION(:,:), ALLOCATABLE, SAVE :: btotal
contains
subroutine alloc_equilvec(ier)
implicit none
integer, intent(out) :: ier
integer :: nrest,nzest,lw10,lw01,lw20,lw02,lw11
if(nr.le.0.or.nz.le.0) then
ier = -1
@ -43,7 +67,7 @@ contains
call dealloc_equilvec
allocate(rv(nr),zv(nz),tr(nrest),tz(nzest),tfp(nrest),cfp(nrest), &
btotal(nr,nz),cceq(nr*nz),cceq01(lw01),cceq10(lw10),cceq02(lw02), &
cceq20(lw20),cceq11(lw11),psi(nr,nz),psin(nr,nz),psinr(nr),rhopnr(nr), &
cceq20(lw20),cceq11(lw11),psin(nr,nz),psinr(nr),rhopnr(nr),fpol(nr), &
qpsi(nr), stat=ier)
if (ier/=0) call dealloc_equilvec
end subroutine alloc_equilvec
@ -63,9 +87,9 @@ contains
if(allocated(cceq02)) deallocate(cceq02)
if(allocated(cceq20)) deallocate(cceq20)
if(allocated(cceq11)) deallocate(cceq11)
if(allocated(psi)) deallocate(psi)
if(allocated(psin)) deallocate(psin)
if(allocated(psinr)) deallocate(psinr)
if(allocated(fpol)) deallocate(fpol)
if(allocated(rhopnr)) deallocate(rhopnr)
if(allocated(qpsi)) deallocate(qpsi)
@ -117,38 +141,107 @@ contains
if(allocated(zlim)) deallocate(zlim)
end subroutine dealloc_lim
subroutine alloc_profvec(ier)
subroutine equinum_psi(rpsim,zpsim,psinv,dpsidr,dpsidz, &
ddpsidrr,ddpsidzz,ddpsidrz)
use dierckx, only : fpbisp
implicit none
integer, intent(out) :: ier
integer :: npest
! local constants
integer, parameter :: lwrk=8,liwrk=2
! arguments
real(wp_), intent(in) :: rpsim,zpsim
real(wp_), intent(out), optional :: psinv,dpsidr,dpsidz, &
ddpsidrr,ddpsidzz,ddpsidrz
ier=0
if(npp.le.0) then
ier = -1
return
! local variables
integer, dimension(liwrk) :: iwrk
real(wp_), dimension(1) :: rrs,zzs,ffspl
real(wp_), dimension(lwrk) :: wrk
!
! here lengths are measured in meters
!
if (rpsim.le.rmxm .and. rpsim.ge.rmnm .and. &
zpsim.le.zmxm .and. zpsim.ge.zmnm) then
if (present(psinv)) then
rrs(1)=rpsim
zzs(1)=zpsim
call fpbisp(tr,nsr,tz,nsz,cceq,3,3,rrs,1,zzs,1,ffspl, &
wrk(1),wrk(5),iwrk(1),iwrk(2))
psinv=(ffspl(1)-psinop)/psiant
end if
if (present(dpsidr)) then
call sub_derpsi(rpsim,zpsim,1,0,dpsidr,cceq10,lw10)
end if
if (present(dpsidz)) then
call sub_derpsi(rpsim,zpsim,0,1,dpsidz,cceq01,lw01)
end if
if (present(ddpsidrr)) then
call sub_derpsi(rpsim,zpsim,2,0,ddpsidrr,cceq20,lw20)
end if
if (present(ddpsidzz)) then
call sub_derpsi(rpsim,zpsim,0,2,ddpsidzz,cceq02,lw02)
end if
if (present(ddpsidrz)) then
call sub_derpsi(rpsim,zpsim,1,1,ddpsidrz,cceq11,lw11)
end if
else
if(present(psinv)) psinv=-1.0_wp_
if(present(dpsidr)) dpsidr=0.0_wp_
if(present(dpsidz)) dpsidz=0.0_wp_
if(present(ddpsidrr)) ddpsidrr=0.0_wp_
if(present(ddpsidzz)) ddpsidzz=0.0_wp_
if(present(ddpsidrz)) ddpsidrz=0.0_wp_
end if
end subroutine equinum_psi
npest=npp+4
call dealloc_profvec
allocate(psrad(npp),terad(npp),derad(npp),zfc(npp),ct(npp,4), &
cz(npp,4),tfn(npest),cfn(npest), &
stat=ier)
if (ier/=0) call dealloc_profvec
end subroutine alloc_profvec
subroutine dealloc_profvec
subroutine sub_derpsi(rpsim,zpsim,nur,nuz,derpsi,cc,lw)
use dierckx, only : fpbisp
implicit none
if(allocated(psrad)) deallocate(psrad)
if(allocated(terad)) deallocate(terad)
if(allocated(derad)) deallocate(derad)
if(allocated(zfc)) deallocate(zfc)
if(allocated(ct)) deallocate(ct)
if(allocated(cz)) deallocate(cz)
if(allocated(tfn)) deallocate(tfn)
if(allocated(cfn)) deallocate(cfn)
! local constants
integer, parameter :: liwrk=2,nrs=1,nzs=1
! arguments
integer :: nur,nuz,lw
real(wp_) :: rpsim,zpsim,derpsi
real(wp_), dimension(lw) :: cc
! local variables
integer :: iwr,iwz
integer, dimension(liwrk) :: iwrk
real(wp_), dimension(1) :: rrs,zzs,ffspl
end subroutine dealloc_profvec
rrs(1)=rpsim
zzs(1)=zpsim
iwr=1+(nr-nur-4)*(nz-nuz-4)
iwz=iwr+4-nur
call fpbisp(tr(nur+1),nsr-2*nur,tz(nuz+1),nsz-2*nuz,cc,3-nur,3-nuz, &
rrs,nrs,zzs,nzs,ffspl,cc(iwr),cc(iwz),iwrk(1),iwrk(2))
derpsi=ffspl(1)*psia
end subroutine sub_derpsi
subroutine equinum_fpol(psinv,fpolv,dfpv)
use dierckx, only : splev,splder
implicit none
! arguments
real(wp_), intent(in) :: psinv
real(wp_), intent(out) :: fpolv
real(wp_), intent(out), optional :: dfpv
! local variables
integer :: ier
real(wp_), dimension(1) :: rrs,ffspl
real(wp_), dimension(nsf) :: wrkfd
!
if(psinv.le.1.0_wp_.and.psinv.gt.0.0_wp_) then
rrs(1)=psinv
call splev(tfp,nsf,cfp,3,rrs,ffspl,1,ier)
fpolv=ffspl(1)
if(present(dfpv)) then
call splder(tfp,nsf,cfp,3,1,rrs,ffspl,1,wrkfd,ier)
dfpv=ffspl(1)/psia
end if
else
fpolv=fpolas
if (present(dfpv)) dfpv=0._wp_
end if
end subroutine equinum_fpol
end module interp_eqprof