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

corrected re-normalization of poloidal flux after spline fitting

Browse Source
This commit is contained in:
Lorenzo Figini 2013-09-20 13:35:45 +00:00
parent 748f2af7c8
commit e76c036ba2
1 changed files with 83 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

146
src/gray.f
View File

@ -1065,12 +1065,14 @@ c
parameter(nnw=501,nnh=501) parameter(nnw=501,nnh=501)
parameter(pi=3.14159265358979d0) parameter(pi=3.14159265358979d0)
parameter(nbb=1000) parameter(nbb=1000)
c parameter(np=100)
character*48 stringa character*48 stringa
dimension fpol(nnw),pres(nnw),qpsi(nnw) dimension fpol(nnw),pres(nnw),qpsi(nnw)
dimension ffprim(nnw),pprim(nnw) dimension ffprim(nnw),pprim(nnw)
dimension psi(nnw,nnh),rv(nnw),zv(nnh),psin(nnw,nnh),psinr(nnw) dimension psi(nnw,nnh),rv(nnw),zv(nnh),psin(nnw,nnh),psinr(nnw)
dimension rbbbs(nbb),zbbbs(nbb) dimension rbbbs(nbb),zbbbs(nbb)
dimension rlim(nbb),zlim(nbb) dimension rlim(nbb),zlim(nbb)
c dimension rcon(2*np+1),zcon(2*np+1)
c c
parameter(nrest=nnw+4,nzest=nnh+4) parameter(nrest=nnw+4,nzest=nnh+4)
parameter(lwrk=4*(nnw+nnh)+11*(nrest+nzest)+nrest*nnh+nzest+54) parameter(lwrk=4*(nnw+nnh)+11*(nrest+nzest)+nrest*nnh+nzest+54)
@ -1089,7 +1091,7 @@ c
dimension fpoli(nnw) dimension fpoli(nnw)
c c
common/pareq1/psia common/pareq1/psia
common/pareq1a/psiaxis0 common/pareq1t/psiant,psinop
common/cent/btrcen,rcen common/cent/btrcen,rcen
common/pareq2/btaxis,rmaxis,zmaxis,rmnm,rmxm,zmnm,zmxm,dr,dz common/pareq2/btaxis,rmaxis,zmaxis,rmnm,rmxm,zmnm,zmxm,dr,dz
common/psinr/psinr common/psinr/psinr
@ -1130,9 +1132,9 @@ c
end if end if
if(ipsinorm.eq.0) then if(ipsinorm.eq.0) then
read (neqdsk,2020) drnr1,dznz1,rcen,rleft,zmid read (neqdsk,2020) drnr1,dznz1,rcen,rleft,zmid
read (neqdsk,2020) rmaxis,zmaxis,psiax,psiedge,btrcen read (neqdsk,2020) rmaxis,zmaxis,psiaxis,psiedge,btrcen
read (neqdsk,2020) current,simag,xdum,rmaxis,xdum read (neqdsk,2020) current,xdum,xdum,xdum,xdum
read (neqdsk,2020) zmaxis,xdum,sibry,xdum,xdum read (neqdsk,2020) xdum,xdum,xdum,xdum,xdum
read (neqdsk,2020) (fpol(i),i=1,nr) read (neqdsk,2020) (fpol(i),i=1,nr)
read (neqdsk,2020) (pres(i),i=1,nr) read (neqdsk,2020) (pres(i),i=1,nr)
read (neqdsk,2020) (ffprim(i),i=1,nr) read (neqdsk,2020) (ffprim(i),i=1,nr)
@ -1141,9 +1143,9 @@ c
read (neqdsk,2020) (qpsi(i),i=1,nr) read (neqdsk,2020) (qpsi(i),i=1,nr)
else else
read (neqdsk,*) drnr1,dznz1,rcen,rleft,zmid read (neqdsk,*) drnr1,dznz1,rcen,rleft,zmid
read (neqdsk,*) rmaxis,zmaxis,psiax,psiedge,btrcen read (neqdsk,*) rmaxis,zmaxis,psiaxis,psiedge,btrcen
read (neqdsk,*) current,simag,xdum,rmaxis,xdum read (neqdsk,*) current,xdum,xdum,xdum,xdum
read (neqdsk,*) zmaxis,xdum,sibry,xdum,xdum read (neqdsk,*) xdum,xdum,xdum,xdum,xdum
read (neqdsk,*) (fpol(i),i=1,nr) read (neqdsk,*) (fpol(i),i=1,nr)
read (neqdsk,*) (pres(i),i=1,nr) read (neqdsk,*) (pres(i),i=1,nr)
read (neqdsk,*) (ffprim(i),i=1,nr) read (neqdsk,*) (ffprim(i),i=1,nr)
@ -1172,7 +1174,7 @@ c
c icocos mod 10 = 1,4,5,8: psi increasing with CCW Ip c icocos mod 10 = 1,4,5,8: psi increasing with CCW Ip
c icocos mod 10 = 2,3,6,7: psi decreasing with CCW Ip c icocos mod 10 = 2,3,6,7: psi decreasing with CCW Ip
psiedge=-psiedge psiedge=-psiedge
psiax=-psiax psiaxis=-psiaxis
if (ipsinorm.eq.0) then if (ipsinorm.eq.0) then
do j=1,nz do j=1,nz
do i=1,nr do i=1,nr
@ -1213,7 +1215,7 @@ c
c psi function c psi function
psia0=psiedge-psiax psia0=psiedge-psiaxis
c icocos=0: adapt psi to force Ip sign, otherwise maintain psi c icocos=0: adapt psi to force Ip sign, otherwise maintain psi
if (icocosmod.ne.0) sgniphi=sign(1.0d0,-psia0) if (icocosmod.ne.0) sgniphi=sign(1.0d0,-psia0)
current=sign(current,sgniphi) current=sign(current,sgniphi)
@ -1222,12 +1224,18 @@ c icocos=0: adapt psi to force Ip sign, otherwise maintain psi
c icocos>10: input psi is in Wb c icocos>10: input psi is in Wb
c icocos<10: input psi is in Wb/rad (gray convention) c icocos<10: input psi is in Wb/rad (gray convention)
if (icocos.ge.10) psia=psia/(2.0d0*pi) if (icocos.ge.10) psia=psia/(2.0d0*pi)
c
c do j=1,nz
c do i=1,nr
c write(80,2021) rv(i),zv(j),psi(i,j)
c enddo
c write(80,*) ' '
c enddo
psiaxis0=0.0d0
do j=1,nz do j=1,nz
do i=1,nr do i=1,nr
if(ipsinorm.eq.0) then if(ipsinorm.eq.0) then
psin(i,j)=(psi(i,j)-psiax)/(psia0) psin(i,j)=(psi(i,j)-psiaxis)/(psia0)
psi(i,j)=psin(i,j)*psia psi(i,j)=psin(i,j)*psia
else else
psi(i,j)=psin(i,j)*psia psi(i,j)=psin(i,j)*psia
@ -1237,12 +1245,13 @@ c icocos<10: input psi is in Wb/rad (gray convention)
enddo enddo
enddo enddo
c c
c spline interpolation of psi(i,j) and derivatives c spline fitting/interpolation of psin(i,j) and derivatives
c c
iopt=0 iopt=0
call regrid(iopt,nr,rv,nz,zv,fvpsi,rmnm,rmxm,zmnm,zmxm, call regrid(iopt,nr,rv,nz,zv,fvpsi,rmnm,rmxm,zmnm,zmxm,
. kspl,kspl,sspl,nrest,nzest,nsr,tr,nsz,tz,cc,fp, . kspl,kspl,sspl,nrest,nzest,nsr,tr,nsz,tz,cc,fp,
. wrk,lwrk,iwrk,liwrk,ier) . wrk,lwrk,iwrk,liwrk,ier)
c if ier=-1 data are fitted using sspl=0
if(ier.eq.-1) then if(ier.eq.-1) then
sspl=0.0d0 sspl=0.0d0
call regrid(iopt,nr,rv,nz,zv,fvpsi,rmnm,rmxm,zmnm,zmxm, call regrid(iopt,nr,rv,nz,zv,fvpsi,rmnm,rmxm,zmnm,zmxm,
@ -1291,6 +1300,32 @@ c
nuz=1 nuz=1
call parder(tr,nsr,tz,nsz,cc,kspl,kspl,nur,nuz,rv,nr,zv,nz, call parder(tr,nsr,tz,nsz,cc,kspl,kspl,nur,nuz,rv,nr,zv,nz,
. ffvpsi,cc11,lw11,iwrkd,ldiwrk,ier) . ffvpsi,cc11,lw11,iwrkd,ldiwrk,ier)
c
c scaling of f_poloidal
c
c icocos=0: adapt fpol to force Ip sign, otherwise maintain fpol
if (icocosmod.ne.0) sgnbphi=sign(1.0d0,fpol(nr))
btrcen=sign(btrcen,sgnbphi)
do i=1,nr
fpol(i)=sgnbphi*abs(fpol(i))*factb
wf(i)=1.0d0
end do
wf(nr)=1.0d2
c
c spline interpolation of fpol(i)
c
iopt=0
xb=0.0d0
xe=1.0d0
ssfp=0.01d0
call curfit(iopt,nr,psinr,fpol,wf,xb,xe,kspl,ssfp,nrest,nsft,
. tfp,cfp,fp,wrkf,lwrkf,iwrkf,ier)
c
call splev(tfp,nsft,cfp,3,psinr,fpoli,nr,ier)
fpolas=fpoli(nr)
c
c read plasma boundaries from eqdsk file
c c
read (neqdsk,*) nbbbs,nlim read (neqdsk,*) nbbbs,nlim
if(nbbbs.gt.0) then if(nbbbs.gt.0) then
@ -1298,6 +1333,9 @@ c
. read (neqdsk,*) (rbbbs(i),zbbbs(i),i=1,nbbbs) . read (neqdsk,*) (rbbbs(i),zbbbs(i),i=1,nbbbs)
if(ipsinorm.eq.0) if(ipsinorm.eq.0)
. read (neqdsk,2020) (rbbbs(i),zbbbs(i),i=1,nbbbs) . read (neqdsk,2020) (rbbbs(i),zbbbs(i),i=1,nbbbs)
c do i=1,nbbbs
c write(51,*) rbbbs(i),zbbbs(i)
c end do
end if end if
if(nlim.gt.0) then if(nlim.gt.0) then
if(ipsinorm.eq.1) if(ipsinorm.eq.1)
@ -1332,37 +1370,18 @@ c
if(zbmax.ge.zmxm) zbmax=zbmax-dz if(zbmax.ge.zmxm) zbmax=zbmax-dz
if(rbmax.ge.rmxm) rbmax=rbmax-dr if(rbmax.ge.rmxm) rbmax=rbmax-dr
c c
c scaling of f_poloidal c start with uncorrected normalized psi
c c
c icocos=0: adapt fpol to force Ip sign, otherwise maintain fpol psinop=0.0d0
if (icocosmod.ne.0) sgnbphi=sign(1.0d0,fpol(nr)) psinxp=1.0d0
btrcen=sign(btrcen,sgnbphi) psiant=1.0d0
do i=1,nr
fpol(i)=sgnbphi*abs(fpol(i))*factb
wf(i)=1.0d0
end do
wf(nr)=1.0d2
c
c spline interpolation of fpol(i)
c
iopt=0
xb=0.0d0
xe=1.0d0
ssfp=0.01d0
call curfit(iopt,nr,psinr,fpol,wf,xb,xe,kspl,ssfp,nrest,nsft,
. tfp,cfp,fp,wrkf,lwrkf,iwrkf,ier)
c
call splev(tfp,nsft,cfp,3,psinr,fpoli,nr,ier)
fpolas=fpoli(nr)
c c
c search for O-point c search for O-point
c c
call points_ox(rmaxis,zmaxis,rmop,zmop,psinop,info) call points_ox(rmaxis,zmaxis,rmop,zmop,psinoptmp,info)
rmaxis=rmop rmaxis=rmop
zmaxis=zmop zmaxis=zmop
print'(a,2f8.4,es12.5)','O-point',rmop,zmop,psinop print'(a,2f8.4,es12.5)','O-point',rmop,zmop,psinoptmp
c c
c search for X-point if ixp not = 0 c search for X-point if ixp not = 0
c c
@ -1370,15 +1389,14 @@ c
if(ixp.lt.0) then if(ixp.lt.0) then
r10=rbmin r10=rbmin
z10=zbmin z10=zbmin
call points_ox(r10,z10,rxp,zxp,psinxp,info) call points_ox(r10,z10,rxp,zxp,psinxptmp,info)
if(psinxp.ne.-1.0d0) then if(psinxp.ne.-1.0d0) then
print'(a,2f8.4,es12.5)','X-point',rxp,zxp,psinxp print'(a,2f8.4,es12.5)','X-point',rxp,zxp,psinxptmp
rbmin=rxp rbmin=rxp
zbmin=zxp zbmin=zxp
delpsinox=(psinxp-psinop) psinop=psinoptmp
psia=psia*delpsinox psinxp=psinxptmp
deltapsi=abs(psia) psiant=psinxp-psinop
psiaxis0=psia*psinop
psin1=1.0d0 psin1=1.0d0
r10=rmaxis r10=rmaxis
z10=(zbmax+zmaxis)/2.0d0 z10=(zbmax+zmaxis)/2.0d0
@ -1392,14 +1410,13 @@ c print'(a)','no X-point'
else else
r10=rmop r10=rmop
z10=zbmax z10=zbmax
call points_ox(r10,z10,rxp,zxp,psinxp,info) call points_ox(r10,z10,rxp,zxp,psinxptmp,info)
if(psinxp.ne.-1.0d0) then if(psinxp.ne.-1.0d0) then
print'(a,2f8.4,e16.8)','X-point',rxp,zxp,psinxp print'(a,2f8.4,e16.8)','X-point',rxp,zxp,psinxptmp
zbmax=zxp zbmax=zxp
delpsinox=(psinxp-psinop) psinop=psinoptmp
psia=psia*delpsinox psinxp=psinxptmp
deltapsi=abs(psia) psiant=psinxp-psinop
psiaxis0=psia*psinop
psin1=1.0d0 psin1=1.0d0
z10=(zbmin+zmaxis)/2.0d0 z10=(zbmin+zmaxis)/2.0d0
call points_tgo(r10,z10,r1,z1,psin1,info) call points_tgo(r10,z10,r1,z1,psin1,info)
@ -1413,10 +1430,8 @@ c print'(a)','no X-point'
c c
if (ixp.eq.0) then if (ixp.eq.0) then
psin1=1.0d0 psin1=1.0d0
delpsinox=(psin1-psinop) psinop=psinoptmp
psia=psia*delpsinox psiant=psin1-psinop
deltapsi=abs(psia)
psiaxis0=psia*psinop
r10=rmaxis r10=rmaxis
z10=(zbmax+zmaxis)/2.0d0 z10=(zbmax+zmaxis)/2.0d0
call points_tgo(r10,z10,r1,z1,psin1,info) call points_tgo(r10,z10,r1,z1,psin1,info)
@ -1440,7 +1455,7 @@ c compute B_toroidal on axis
c compute normalized rho_tor from eqdsk q profile c compute normalized rho_tor from eqdsk q profile
call rhotor(nr) call rhotor(nr)
c phitedge=deltapsi*rhotsx*2*pi c phitedge=abs(psia)*rhotsx*2*pi
c rrtor=sqrt(phitedge/abs(btrcen)/pi) c rrtor=sqrt(phitedge/abs(btrcen)/pi)
c compute flux surface averaged quantities c compute flux surface averaged quantities
@ -1450,6 +1465,12 @@ c compute flux surface averaged quantities
zup=zmaxis+(zbmax-zmaxis)/10.0d0 zup=zmaxis+(zbmax-zmaxis)/10.0d0
zlw=zmaxis-(zmaxis-zbmin)/10.0d0 zlw=zmaxis-(zmaxis-zbmin)/10.0d0
call flux_average call flux_average
c ipr=1
c call contours_psi(1.0d0,np,rcon,zcon,ipr)
c do ii=1,2*np+1
c write(52,*) rcon(ii), zcon(ii)
c end do
c
c locate psi surface for q=1.5 and q=2 c locate psi surface for q=1.5 and q=2
@ -2066,7 +2087,7 @@ c
dimension czc(nrest),zeroc(mest) dimension czc(nrest),zeroc(mest)
c c
common/pareq1/psia common/pareq1/psia
common/pareq1a/psiaxis0 common/pareq1t/psiant,psinop
common/coffeqn/nsr,nsz,nsft common/coffeqn/nsr,nsz,nsft
common/coffeq/cc common/coffeq/cc
common/coffeqt/tr,tz common/coffeqt/tr,tz
@ -2092,7 +2113,7 @@ c
iopt=1 iopt=1
call profil(iopt,tr,nsr,tz,nsz,cc,kspl,kspl,zc,nsr,czc,ier) call profil(iopt,tr,nsr,tz,nsz,cc,kspl,kspl,zc,nsr,czc,ier)
if(ier.gt.0) print*,' profil =',ier if(ier.gt.0) print*,' profil =',ier
val=h+psiaxis0/psia val=h*psiant+psinop
call sproota(val,tr,nsr,czc,zeroc,mest,m,ier) call sproota(val,tr,nsr,czc,zeroc,mest,m,ier)
if (zeroc(1).gt.rwallm) then if (zeroc(1).gt.rwallm) then
rcn(ic)=zeroc(1) rcn(ic)=zeroc(1)
@ -3401,7 +3422,7 @@ c
common/derip/dpsidr,dpsidz,ddpsidrr,ddpsidzz,ddpsidrz,fpolv,ffpv common/derip/dpsidr,dpsidz,ddpsidrr,ddpsidzz,ddpsidrz,fpolv,ffpv
common/pareq1/psia common/pareq1/psia
common/pareq2/btaxis,rmaxis,zmaxis,rmnm,rmxm,zmnm,zmxm,dr,dz common/pareq2/btaxis,rmaxis,zmaxis,rmnm,rmxm,zmnm,zmxm,dr,dz
common/pareq1a/psiaxis0 common/pareq1t/psiant,psinop
c c
common/coffeqt/tr,tz common/coffeqt/tr,tz
common/coffeqtp/tfp common/coffeqtp/tfp
@ -3433,9 +3454,9 @@ c
nsz=nszt nsz=nszt
call fpbisp(tr,nsr,tz,nsz,ccspl,3,3, call fpbisp(tr,nsr,tz,nsz,ccspl,3,3,
. rrs,nrs,zzs,nzs,ffspl,wrk(1),wrk(5),iwrk(1),iwrk(2)) . rrs,nrs,zzs,nzs,ffspl,wrk(1),wrk(5),iwrk(1),iwrk(2))
psinv=ffspl(1)-psiaxis0/psia psinv=(ffspl(1)-psinop)/psiant
c if(psinv.lt.0.0d0) if(psinv.lt.0.0d0)
c . print'(a,3e12.4)', ' psin < 0 , R, z ',psinv,rpsim,zpsim . print'(a,3e12.4)', ' psin < 0 , R, z ',psinv,rpsim,zpsim
c c
nur=1 nur=1
nuz=0 nuz=0
@ -3541,8 +3562,7 @@ c
dimension cc(nnw*nnh),tr(nrest),tz(nzest) dimension cc(nnw*nnh),tr(nrest),tz(nzest)
dimension czc(nrest),zeroc(mest) dimension czc(nrest),zeroc(mest)
c c
common/pareq1/psia common/pareq1t/psiant,psinop
common/pareq1a/psiaxis0
common/pareq2/btaxis,rmaxis,zmaxis,rmnm,rmxm,zmnm,zmxm,dr,dz common/pareq2/btaxis,rmaxis,zmaxis,rmnm,rmxm,zmnm,zmxm,dr,dz
common/coffeqn/nsr,nsz,nsft common/coffeqn/nsr,nsz,nsft
common/coffeq/cc common/coffeq/cc
@ -3552,7 +3572,7 @@ c
zc=zmaxis zc=zmaxis
call profil(iopt,tr,nsr,tz,nsz,cc,kspl,kspl,zc,nsr,czc,ier) call profil(iopt,tr,nsr,tz,nsz,cc,kspl,kspl,zc,nsr,czc,ier)
if(ier.gt.0) print*,' profil =',ier if(ier.gt.0) print*,' profil =',ier
val=h+psiaxis0/psia val=h*psiant+psinop
call sproota(val,tr,nsr,czc,zeroc,mest,m,ier) call sproota(val,tr,nsr,czc,zeroc,mest,m,ier)
r1=zeroc(1) r1=zeroc(1)
r2=zeroc(2) r2=zeroc(2)