Modified test in density extrapolation at boundary

This commit is contained in:
Lorenzo Figini 2020-03-06 10:48:12 +00:00
parent 6892646623
commit 4bb3841049
2 changed files with 19 additions and 9 deletions

View File

@ -225,7 +225,7 @@ contains
! local variables
integer, parameter :: iopt=0, kspl=3
integer :: n, npest, lwrkf, ier
real(wp_) :: xb, xe, fp, xnv, xxp,xxm,delta2
real(wp_) :: xb, xe, fp, xnv, xxp,xxm,delta2,ssplne_loc
real(wp_), dimension(:), allocatable :: wf, wrkf
integer, dimension(:), allocatable :: iwrkf
real(wp_), dimension(1) :: dedge,ddedge,d2dedge
@ -235,6 +235,8 @@ contains
lwrkf=n*4+npest*16
allocate(wrkf(lwrkf),iwrkf(npest),wf(n))
ssplne_loc=ssplne
! if necessary, reallocate spline arrays
if(.not.allocated(psrad)) then
allocate(psrad(n),ct(n,4),cz(n,4))
@ -263,8 +265,15 @@ contains
xb=zero
xe=psin(n)
wf(:)=one
call curfit(iopt,n,psin,ne,wf,xb,xe,kspl,ssplne,npest, &
call curfit(iopt,n,psin,ne,wf,xb,xe,kspl,ssplne_loc,npest, &
nsfd,tfn,cfn,fp,wrkf,lwrkf,iwrkf,ier)
! if ier=-1 data are re-fitted using sspl=0
if(ier==-1) then
write(*,*) 'density curfit: ier=-1. Re-fitting with interpolating spline'
ssplne_loc=0.0_wp_
call curfit(iopt,n,psin,ne,wf,xb,xe,kspl,ssplne_loc,npest, &
nsfd,tfn,cfn,fp,wrkf,lwrkf,iwrkf,ier)
end if
! compute polinomial extrapolation matching the spline boundary up to the
! 2nd order derivative, extending the profile up to psi=psdbnd where
@ -284,7 +293,7 @@ contains
delta2=(ddenpp/d2denpp)**2-2.0_wp_*denpp/d2denpp
xnv=psnpp-ddenpp/d2denpp
if(delta2 < zero) then
if(xnv > psnpp) psdbnd=min(psdbnd,xnv)
! if(xnv > psnpp) psdbnd=min(psdbnd,xnv)
else
xxm=xnv-sqrt(delta2)
xxp=xnv+sqrt(delta2)
@ -293,6 +302,7 @@ contains
else if (xxp > psnpp) then
psdbnd=min(psdbnd,xxp)
end if
write(*,*) 'density psdbnd=',psdbnd
end if
deallocate(iwrkf,wrkf,wf)

View File

@ -176,7 +176,7 @@ contains
else
call equinum_psi(rmaxis,zmaxis,ddpsidrr=ddpsidrr,ddpsidzz=ddpsidzz)
end if
qq=btaxis/sqrt(ddpsidrr*ddpsidzz)
qq=abs(btaxis)/sqrt(ddpsidrr*ddpsidzz)
ajphiav=-ccj*(ddpsidrr+ddpsidzz)/rmaxis
psicon(1)=0.0_wp_
@ -412,7 +412,7 @@ contains
do jp=1,npsi
call print_fluxav(rpstab(jp),frhotor(rpstab(jp)),bav(jp),bmxpsi(jp), &
bmnpsi(jp),varea(jp),vvol(jp),vcurrp(jp),vajphiav(jp), &
ffc(jp),vratja(jp),vratjb(jp))
ffc(jp),vratja(jp),vratjb(jp),qqv(jp))
end do
ninpr=(npsi-1)/10
@ -558,18 +558,18 @@ contains
subroutine print_fluxav(psin,rhot,bav,bmx,bmn,area,vol,currp,ajphiav, &
ffc,ratja,ratjb)
ffc,ratja,ratjb,qq)
use const_and_precisions, only : wp_, comp_tiny
use units, only : uflx
implicit none
! arguments
real(wp_), intent(in) :: psin,rhot,bav,bmx,bmn,area,vol,currp,ajphiav, &
ffc,ratja,ratjb
ffc,ratja,ratjb,qq
if (psin < comp_tiny) &
write(uflx,*)' #rhop rhot |<B>| |Bmx| |Bmn| Area Vol |I_pl| <J_phi> fc ratJa ratJb'
write(uflx,*)' #rhop rhot |<B>| |Bmx| |Bmn| Area Vol |I_pl| <J_phi> fc ratJa ratJb qq'
write(uflx,'(20(1x,e12.5))') psin,rhot,bav,bmx,bmn,area,vol,currp,ajphiav, &
ffc,ratja,ratjb
ffc,ratja,ratjb,qq
end subroutine print_fluxav
end module magsurf_data