V3FIT
mapperb.f
1  SUBROUTINE mapperb
2  USE precision
3  USE mapg_mod
4 c-----------------------------------------------------------------------
5 c changed dpsi to dpsic : rlm 7/3/96
6 c changed dpsi2 to dpsiv : same
7 c-----------------------------------------------------------------------
8  IMPLICIT NONE
9  REAL(rprec) :: dpsic,xval(kpsi),chipsipsi(kpsi)
10  INTEGER :: itype, i,j
11  REAL(rprec) :: psival2(nxd),dum2(nxd)
12  REAL(rprec) :: dpsiv
13  REAL(rprec) :: dchi,psitest
14 c have trouble finding psilim contour on mANY eqdsks
15 c percenflux ALLows edge scrapeoff--rlm 10/2/96
16  dchi=(psilim-psiaxis)*percenflux
17  itype=0 ! makes equally spaced psic
18  CALL initpsi(psic,psiv,xval,chipsi,chipsipsi,dpsic,npsi,
19  $ alpsi,dchi,itype)
20 c WRITE(6,'("dchi=",e12.4)') dchi
21  DO j=2,npsi
22  psiv(j)=psiv(j)+psiaxis
23  ENDdo
24  psiv(1)=psiaxis
25  psiv(npsi)=psiaxis+dchi
26  dpsiv=(psilim-psiaxis)/(nx-1)
27  DO i=1,nx
28  psival2(i)=psiaxis+(i-1.)*dpsiv
29  END DO
30  psival2(nx)=psilim
31 c
32 c set up pprime, ffprime, f, and qsfin arrays
33  CALL spline1d(pprime,psiv,npsi,spp,psival2,nx,dum2)
34  CALL spline1d(ffprime,psiv,npsi,sffp,psival2,nx,dum2)
35  CALL spline1d(fval,psiv,npsi,sf,psival2,nx,dum2)
36  CALL spline1d(qsfin,psiv,npsi,qpsi,psival2,nx,dum2)
37  CALL spline1d(press,psiv,npsi,sp,psival2,nx,dum2)
38  CALL spline1d(pw,psiv,npsi,pressw,psival2,nx,dum2)
39  CALL spline1d(pwp,psiv,npsi,pwprim,psival2,nx,dum2)
40  CALL spline1d(rho,psiv,npsi,rho0,psival2,nx,dum2)
41  CALL spline1d(rhop,psiv,npsi,rho0p,psival2,nx,dum2)
42 c
43 c bicubic spline on psi used by cntour which is called by equalarc
44  CALL bcspline(xgrid,zgrid,psixz,nx,nz,nxd,csplpsi)
45 c first surface is easy
46  i=1
47  DO j=1,nthet
48  xs(i,j)=xaxis
49  zs(i,j)=zaxis
50  bps(i,j)=0.
51  END DO
52  DO i=2,npsi
53  psitest=psiv(i)
54 ! WRITE(*,'("i=",i5," psitest=",e12.4)') i,psitest
55  psitest=psiv(i)
56  CALL equalarc(psitest,i)
57  END DO
58  END SUBROUTINE mapperb