1 subroutine surfaces_plot(g1,g2,device)
9 character*(*) :: device
10 real*4,
dimension(:),
allocatable :: sqphin,thetap,xp,yp
11 real,
pointer :: xpnt(:,:),ypnt(:,:)
13 real*4 xmin, xmax, zmin, zmax
14 integer :: id0, id1, id, pgopen
15 integer :: jpsi, itht, j, ij, m
16 character(len=60) :: mlabel
18 subroutine evals_boundary(g2,xp,yp,icount)
21 real(rprec),
dimension(0:mu-1,0:0) :: rbc,zbs,rbs,zbc
22 real*4,
dimension(:),
allocatable :: rb, zb
23 real*4,
dimension(*) :: xp, yp
25 end subroutine evals_boundary
35 call pgpap (8., (zmax-zmin)/(xmax-xmin)/2)
39 call pgenv (xmin, xmax, zmin, zmax,1,0)
40 call pglab(
'R(cm)',
'Z(cm)',
'mapcode')
43 m=g1%limitr;
allocate(xp(m),yp(m))
44 xp(1:m)=100*g1%xlim(1:m);yp(1:m)=100*g1%ylim(1:m)
46 if(
allocated(xp) )
deallocate(xp,yp)
47 allocate(xp(nu),yp(nu))
49 call evals_boundary(g2,xp,yp,m)
52 if(
allocated(xp) )
deallocate(xp,yp)
56 m=g1%nbdry;
allocate(xp(m),yp(m))
57 xp(1:m)=100*g1%rbdry(1:m);yp(1:m)=100*g1%zbdry(1:m)
59 if(
allocated(xp) )
deallocate(xp,yp)
63 allocate(xp(g2%nthet),yp(g2%nthet))
66 xp(1:itht)=100*g2%rs(j,1:itht)
67 yp(1:itht)=100*g2%zs(j,1:itht)
68 call pgline(itht,xp,yp)
70 if(
allocated(xp) )
deallocate(xp,yp)
71 allocate(xp(g2%npsi),yp(g2%npsi))
75 xp(1:jpsi)=100*g2%rs(1:jpsi,j)
76 yp(1:jpsi)=100*g2%zs(1:jpsi,j)
77 call pgline(jpsi,xp,yp)
81 xp(1:jpsi)=100*g2%rs(1:jpsi,j)
82 yp(1:jpsi)=100*g2%zs(1:jpsi,j)
83 call pgline(jpsi,xp,yp)
85 xp(1:jpsi)=100*g2%rs(1:jpsi,j)
86 yp(1:jpsi)=100*g2%zs(1:jpsi,j)
87 call pgline(jpsi,xp,yp)
90 call pgenv (xmin, xmax, zmin, zmax,1,0)
91 call pglab(
'R(cm)',
'Z(cm)',
'DESCUR v mapped eqdsk')
92 write(mlabel,fmt=
'("% boundary flux=",f8.4)')
93 . 100.*g2%fraction_bndry
94 CALL pgmtxt(
'B',2.25,0.5,0.5,trim(mlabel))
95 write(mlabel,fmt=
'("mpol=",i3.3)')mu
96 CALL pgmtxt(
'T',0.325,0.5,0.5,trim(mlabel))
100 if(
allocated(xp) )
deallocate(xp,yp)
101 m=g1%limitr;
allocate(xp(m),yp(m))
102 xp(1:m)=100*g1%xlim(1:m);yp(1:m)=100*g1%ylim(1:m)
104 if(
allocated(xp) )
deallocate(xp,yp)
107 if(
allocated(xp) )
deallocate(xp,yp)
108 allocate(xp(g2%nthet),yp(g2%nthet))
111 xp(1:itht)=100*g2%rs(j,1:itht)
112 yp(1:itht)=100*g2%zs(j,1:itht)
113 call pgpt(itht,xp,yp,5)
114 if(
allocated(xp) )
deallocate(xp,yp)
116 if(
allocated(xp) )
deallocate(xp,yp)
117 allocate(xp(nu),yp(nu))
119 call evals_boundary(g2,xp,yp,m)
124 end subroutine surfaces_plot
127 dimension rc(ncoil), zc(ncoil), wc(ncoil),
128 .hc(ncoil),xx(5),yy(5)
129 dimension ac(ncoil),ac2(ncoil)
132 &.8608,.8614,.8628,.8611,1.0041,2.6124,
133 &2.3733,1.2518,1.6890,.8608,.8607,.8611,
134 &.8630,1.0025,2.6124,2.3834,1.2524,1.6889/
136 &.16830,.50810,.84910,1.1899,1.5169,0.4376,
137 &1.1171,1.6019,1.5874,-.17370,-.51350,-.85430,
138 &-1.1957,-1.5169,-0.4376,-1.1171,-1.6027,-1.5780/
140 &.0508,.0508,.0508,.0508,.13920,0.17320,
141 &0.1880,.23490,.16940,.0508,.0508,.0508,
142 &.0508,.13920,0.17320,0.1880,.23490,.16940/
144 &.32106,.32106,.32106,.32106,.11940,0.1946,
145 &0.16920,.08510,.13310,.32106,.32106,.32106,
146 &.32106,.11940,0.1946,0.16920,.08510,.13310/
148 &0.,0.,0.,0.,45.0,0.,
150 &0.,-45.0,0.,0.,0.,0./
152 &0.,0.,0.,0.,0.,92.40,
153 &108.06,0.,0.,0.,0.,0.,
154 &0.,0.,-92.40,-108.06,0.,0./
161 sn1=sin(ac(i)*pi/180)
162 cos1=cos(ac(i)*pi/180)
164 sn2=sin(ac2(i)*pi/180)
165 cos2=cos(ac2(i)*pi/180)
167 if(ac2(i).eq.0)
go to 40
205 end subroutine pltcol
206 subroutine arc_integral(rv,zv,jpsi,itht,arcl)
208 real,
dimension(jpsi,itht) :: rv,zv
209 real,
dimension(:),
allocatable :: dl
210 if(.not.
allocated(dl))
allocate(dl(itht-1))
214 dl=sqrt( (rv(k,2:itht)-rv(k,1:itht-1))**2 +
215 & (zv(k,2:itht)-zv(k,1:itht-1))**2 )
219 end subroutine arc_integral