V3FIT
vcoords.f
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)
4  USE stel_kinds
5  USE booz_persistent, ONLY: cosm_b, sinm_b, cosn_b, sinn_b
6  IMPLICIT NONE
7 C-----------------------------------------------
8 C D u m m y A r g u m e n t s
9 C-----------------------------------------------
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
19 C-----------------------------------------------
20 C L o c a l P a r a m e t e r s
21 C-----------------------------------------------
22  REAL(rprec), PARAMETER :: zero = 0, one = 1
23 C-----------------------------------------------
24 C L o c a l V a r i a b l e s
25 C-----------------------------------------------
26  INTEGER :: js, js1, mn, m, n
27  REAL(rprec) :: t1, t2, rc, zs, sgn, rs, zc
28  REAL(rprec), DIMENSION(nznt) :: tsin, tcos
29 C-----------------------------------------------
30  js = jrad
31  js1= js-1
32  IF (js .le. 1) stop 'js must be > 1!'
33 
34  r = zero
35  z = zero
36 
37 !
38 ! Compute Reven, Rodd and Zeven, Zodd in Real Space
39 ! on full radial grid at js and js1 (will average onto half-mesh later)
40 ! Lambda is on half grid
41 ! (even, nparity = 0; odd, nparity = 1)
42 !
43  IF (nparity .eq. 0) THEN
44  t1 = one
45  t2 = one
46  lt = zero
47  lz = zero
48  lam = zero
49  ELSE IF (js .gt. 2) THEN
50  t1 = one/sfull(js)
51  t2 = one/sfull(js1)
52  ELSE
53  t1 = one/sfull(2)
54  t2 = one
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)/
57  2 sfull(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)/
60  2 sfull(3)
61  IF (lasym) THEN
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)/
64  2 sfull(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)/
67  2 sfull(3)
68  ENDIF
69  ENDIF
70 
71  t1 = t1/2
72  t2 = t2/2
73 
74  DO mn = 1, mnmax
75  m = nint(xm(mn))
76  IF (mod(m,2) .ne. nparity) cycle
77 
78  n = nint(abs(xn(mn)/nfp))
79  sgn = sign(one,xn(mn))
80 
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)
87  r = r + tcos*rc
88  z = z + tsin*zs
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)
92  IF (lasym) THEN
93  rs = t1*rmns(mn,js) + t2*rmns(mn,js)
94  zc = t1*zmnc(mn,js) + t2*zmnc(mn,js)
95  r = r + tsin*rs
96  z = z + tcos*zc
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)
100  END IF
101  END DO
102 
103  END SUBROUTINE vcoords_rz
104 
105  SUBROUTINE vcoords_w(bmnc, bmns, pmns, pmnc, xm, xn, jrad,
106  1 mnmax, bmod, wt, wz, w, nznt, nfp, lasym)
107  USE stel_kinds
108  USE booz_persistent, ONLY: cosm_w => cosm_nyq, sinm_w => sinm_nyq,
109  1 cosn_w => cosn_nyq, sinn_w => sinn_nyq
110  IMPLICIT NONE
111 C-----------------------------------------------
112 C D u m m y A r g u m e n t s
113 C-----------------------------------------------
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
119 C-----------------------------------------------
120 C L o c a l P a r a m e t e r s
121 C-----------------------------------------------
122  REAL(rprec), PARAMETER :: zero = 0, one = 1
123 C-----------------------------------------------
124 C L o c a l V a r i a b l e s
125 C-----------------------------------------------
126  INTEGER :: mn, m, n
127  REAL(rprec) :: sgn
128  REAL(rprec), DIMENSION(nznt) :: tsin, tcos
129 C-----------------------------------------------
130  IF (jrad .le. 1) stop 'jrad must be > 1!'
131 
132 !
133 ! Compute w and derivatives (p transformation of right-side in Eq.(10))
134 ! and |B| on half radial grid in REAL space
135 !
136  w = zero
137  wt = zero
138  wz = zero
139  bmod = zero
140 
141  DO mn = 1, mnmax
142  m = nint(xm(mn))
143  n = nint(abs(xn(mn)))/nfp
144  sgn = sign(one,xn(mn))
145 
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)
154 
155  IF (.not.lasym) cycle
156 
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)
161 
162  END DO
163 
164  END SUBROUTINE vcoords_w
165 
166 
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)
170  USE stel_kinds
171  USE booz_persistent, ONLY: thgrd, ztgrd
172  IMPLICIT NONE
173 C-----------------------------------------------
174 C D u m m y A r g u m e n t s
175 C-----------------------------------------------
176  INTEGER :: jsurf, ns, mnmax, nznt, nfp, mboz, nboz
177  REAL(rprec), DIMENSION(mnmax,ns), INTENT(in) :: rmnc, zmns !BOOZER COORDINATES
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
184 C-----------------------------------------------
185 C L o c a l P a r a m e t e r s
186 C-----------------------------------------------
187  REAL(rprec), PARAMETER :: one = 1
188 C-----------------------------------------------
189 C L o c a l V a r i a b l e s
190 C-----------------------------------------------
191  INTEGER :: js, mn, m, n
192  REAL(rprec) :: rc, zs, sgn, rs, zc
193  REAL(rprec), DIMENSION(nznt) :: tsin, tcos
194 C-----------------------------------------------
195  js = jsurf
196 
197  r = 0
198  z = 0
199 
200 !
201 ! theta-boz = thgrd: now uniform angle mesh in BOOZER space
202 ! zeta-boz = ztgrd
203 !
204 ! IF user wants to check xform in VMEC space, change
205 ! thgrd -> thgrd + uboz, ztgrd -> ztgrd in call to trigfunc
206 !
207  CALL trigfunc (thgrd, ztgrd, cosm_boz, sinm_boz, cosn_boz,
208  1 sinn_boz, mboz, nboz, nznt)
209 
210 !
211 ! Compute Reven, Rodd and Zeven, Zodd in Real BOOZER Space
212 ! on half radial grid (rmncb, zmnsb, etc ARE ALREADY on half mesh
213 !
214 
215  DO mn = 1, mnmax
216  m = nint(xmb(mn))
217  n = nint(abs(xnb(mn)/nfp))
218  sgn = sign(one,xnb(mn))
219 
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
224  rc = rmnc(mn,js)
225  zs = zmns(mn,js)
226  r = r + tcos*rc
227  z = z + tsin*zs
228  IF (lasym) THEN
229  rs = rmns(mn,js)
230  zc = zmnc(mn,js)
231  r = r + tsin(:nznt)*rs
232  z = z + tcos(:nznt)*zc
233  END IF
234  END DO
235 
236  END SUBROUTINE vcoords_rzb
Generated on Thu Mar 5 2020 15:49:23 for V3FIT by   doxygen 1.8.17