1 SUBROUTINE vcoords_rz(rmnc, zmns, lmns, rmns, zmnc, lmnc, xm, xn,
2 1 ntorsum, ns, jrad, mnmax, r, z, lt, lz, lam, sfull,
3 2 nparity, nznt, nfp, lasym)
5 USE booz_persistent,
ONLY: cosm_b, sinm_b, cosn_b, sinn_b
10 INTEGER :: jrad, ns, mnmax, nparity, nznt, nfp
11 INTEGER,
DIMENSION(0:1) :: ntorsum
12 REAL(rprec),
DIMENSION(mnmax,ns) :: rmnc, zmns, lmns
13 REAL(rprec),
DIMENSION(mnmax,ns) :: rmns, zmnc, lmnc
14 REAL(rprec),
DIMENSION(mnmax),
INTENT(in) :: xm, xn
15 REAL(rprec),
DIMENSION(nznt),
INTENT(out) :: r, z
16 REAL(rprec),
DIMENSION(nznt),
INTENT(out) :: lam, lt, lz
17 REAL(rprec),
DIMENSION(ns),
INTENT(in) :: sfull
18 LOGICAL,
INTENT(in) :: lasym
22 REAL(rprec),
PARAMETER :: zero = 0, one = 1
26 INTEGER :: js, js1, mn, m, n
27 REAL(rprec) :: t1, t2, rc, zs, sgn, rs, zc
28 REAL(rprec),
DIMENSION(nznt) :: tsin, tcos
32 IF (js .le. 1) stop
'js must be > 1!'
43 IF (nparity .eq. 0)
THEN
49 ELSE IF (js .gt. 2)
THEN
55 rmnc(1+ntorsum(0):ntorsum(1),1) = 2*rmnc(1+ntorsum(0):
56 1 ntorsum(1),2)/sfull(2) - rmnc(1+ntorsum(0):ntorsum(1),3)/
58 zmns(1+ntorsum(0):ntorsum(1),1) = 2*zmns(1+ntorsum(0):
59 1 ntorsum(1),2)/sfull(2) - zmns(1+ntorsum(0):ntorsum(1),3)/
62 rmns(1+ntorsum(0):ntorsum(1),1) = 2*rmns(1+ntorsum(0):
63 1 ntorsum(1),2)/sfull(2) - rmns(1+ntorsum(0):ntorsum(1),3)/
65 zmnc(1+ntorsum(0):ntorsum(1),1) = 2*zmnc(1+ntorsum(0):
66 1 ntorsum(1),2)/sfull(2) - zmnc(1+ntorsum(0):ntorsum(1),3)/
76 IF (mod(m,2) .ne. nparity) cycle
78 n = nint(abs(xn(mn)/nfp))
79 sgn = sign(one,xn(mn))
81 tcos = cosm_b(:,m)*cosn_b(:,n)
82 1 + sinm_b(:,m)*sinn_b(:,n)*sgn
83 tsin = sinm_b(:,m)*cosn_b(:,n)
84 1 - cosm_b(:,m)*sinn_b(:,n)*sgn
85 rc = t1*rmnc(mn,js)+t2*rmnc(mn,js1)
86 zs = t1*zmns(mn,js)+t2*zmns(mn,js1)
89 lt = lt + tcos*lmns(mn,js)*xm(mn)
90 lz = lz - tcos*lmns(mn,js)*xn(mn)
91 lam = lam + tsin*lmns(mn,js)
93 rs = t1*rmns(mn,js) + t2*rmns(mn,js)
94 zc = t1*zmnc(mn,js) + t2*zmnc(mn,js)
97 lt = lt - tsin*lmnc(mn,js)*xm(mn)
98 lz = lz + tsin*lmnc(mn,js)*xn(mn)
99 lam = lam + tcos*lmnc(mn,js)
103 END SUBROUTINE vcoords_rz
105 SUBROUTINE vcoords_w(bmnc, bmns, pmns, pmnc, xm, xn, jrad,
106 1 mnmax, bmod, wt, wz, w, nznt, nfp, lasym)
108 USE booz_persistent,
ONLY: cosm_w => cosm_nyq, sinm_w => sinm_nyq,
109 1 cosn_w => cosn_nyq, sinn_w => sinn_nyq
114 INTEGER :: jrad, mnmax, nznt, nfp
115 REAL(rprec),
DIMENSION(mnmax),
INTENT(in) :: xm, xn, pmns, bmnc
116 REAL(rprec),
DIMENSION(mnmax),
INTENT(in) :: pmnc, bmns
117 REAL(rprec),
DIMENSION(nznt),
INTENT(out) :: w, wt, wz, bmod
118 LOGICAL,
INTENT(in) :: lasym
122 REAL(rprec),
PARAMETER :: zero = 0, one = 1
128 REAL(rprec),
DIMENSION(nznt) :: tsin, tcos
130 IF (jrad .le. 1) stop
'jrad must be > 1!'
143 n = nint(abs(xn(mn)))/nfp
144 sgn = sign(one,xn(mn))
146 tcos = cosm_w(:,m)*cosn_w(:,n)
147 1 + sinm_w(:,m)*sinn_w(:,n)*sgn
148 tsin = sinm_w(:,m)*cosn_w(:,n)
149 1 - cosm_w(:,m)*sinn_w(:,n)*sgn
150 w = w + tsin*pmns(mn)
151 wt = wt + tcos*pmns(mn)*xm(mn)
152 wz = wz - tcos*pmns(mn)*xn(mn)
153 bmod= bmod+ tcos*bmnc(mn)
155 IF (.not.lasym) cycle
157 w = w + tcos*pmnc(mn)
158 wt = wt - tsin*pmnc(mn)*xm(mn)
159 wz = wz + tsin*pmnc(mn)*xn(mn)
160 bmod= bmod+ tsin*bmns(mn)
164 END SUBROUTINE vcoords_w
167 SUBROUTINE vcoords_rzb(rmnc, zmns, rmns, zmnc, xmb, xnb,
168 1 cosm_boz, sinm_boz, cosn_boz, sinn_boz,
169 2 mboz, nboz, mnmax, jsurf, ns, r, z, nznt, nfp, lasym)
171 USE booz_persistent,
ONLY: thgrd, ztgrd
176 INTEGER :: jsurf, ns, mnmax, nznt, nfp, mboz, nboz
177 REAL(rprec),
DIMENSION(mnmax,ns),
INTENT(in) :: rmnc, zmns
178 REAL(rprec),
DIMENSION(mnmax,ns),
INTENT(in) :: rmns, zmnc
179 REAL(rprec),
DIMENSION(mnmax),
INTENT(in) :: xmb, xnb
180 REAL(rprec),
DIMENSION(nznt),
INTENT(out) :: r, z
181 REAL(rprec),
DIMENSION(nznt,0:mboz) :: cosm_boz, sinm_boz
182 REAL(rprec),
DIMENSION(nznt,0:nboz) :: cosn_boz, sinn_boz
183 LOGICAL,
INTENT(in) :: lasym
187 REAL(rprec),
PARAMETER :: one = 1
191 INTEGER :: js, mn, m, n
192 REAL(rprec) :: rc, zs, sgn, rs, zc
193 REAL(rprec),
DIMENSION(nznt) :: tsin, tcos
207 CALL trigfunc (thgrd, ztgrd, cosm_boz, sinm_boz, cosn_boz,
208 1 sinn_boz, mboz, nboz, nznt)
217 n = nint(abs(xnb(mn)/nfp))
218 sgn = sign(one,xnb(mn))
220 tcos = cosm_boz(:,m)*cosn_boz(:,n)
221 1 + sinm_boz(:,m)*sinn_boz(:,n)*sgn
222 tsin = sinm_boz(:,m)*cosn_boz(:,n)
223 1 - cosm_boz(:,m)*sinn_boz(:,n)*sgn
231 r = r + tsin(:nznt)*rs
232 z = z + tcos(:nznt)*zc
236 END SUBROUTINE vcoords_rzb