V3FIT
convert.f
1 !-------------------------------------------------------------------------------
21 !-------------------------------------------------------------------------------
22  SUBROUTINE convert_par(rmnc, zmns, lmns,
23  & rmns, zmnc, lmnc,
24  & rzl_array)
25  USE vmec_main
26  USE vmec_params
27  USE parallel_include_module
28  IMPLICIT NONE
29 C-----------------------------------------------
30 C D u m m y A r g u m e n t s
31 C-----------------------------------------------
32  REAL(dp), DIMENSION(mnmax), INTENT(OUT) ::
33  & rmnc, zmns, lmns, rmns, zmnc, lmnc
34  REAL(dp), DIMENSION(0:ntor,0:mpol1,ns,3*ntmax),
35  & INTENT(INOUT) :: rzl_array
36 C-----------------------------------------------
37 C L o c a l P a r a m e t e r s
38 C-----------------------------------------------
39  REAL(dp), PARAMETER :: p5 = 0.5_dp
40 C-----------------------------------------------
41 C L o c a l V a r i a b l e s
42 C-----------------------------------------------
43  INTEGER :: rmncc, rmnss, rmncs, rmnsc, zmncs, zmnsc,
44  & zmncc, zmnss, lmncs, lmnsc, lmncc, lmnss
45  INTEGER :: mn, m, n, n1, bufsize, js
46  REAL(dp) :: t1, sign0, mul1, tbroadon, tbroadoff
47  REAL(dp), ALLOCATABLE, DIMENSION(:) :: bcastbuf
48 C-----------------------------------------------
49 !
50 ! FOR EDGE (js=ns) ONLY:
51 ! CONVERTS INTERNAL MODE REPRESENTATION TO STANDARD
52 ! FORM FOR OUTPUT (COEFFICIENTS OF COS(mu-nv), SIN(mu-nv) WITHOUT mscale,nscale norms)
53 !
54  js = ns
55 #if defined(MPI_OPT)
56  bufsize = (ntor+1)*(mpol1+1)*3*ntmax
57  ALLOCATE(bcastbuf(bufsize))
58  mn=0
59  DO n1 = 1, 3*ntmax
60  DO m = 0, mpol1
61  DO n = 0, ntor
62  mn = mn + 1
63  bcastbuf(mn) = rzl_array(n,m,js,n1)
64  END DO
65  END DO
66  END DO
67  CALL second0(tbroadon)
68  CALL mpi_bcast(bcastbuf, bufsize, mpi_real8, nranks - 1,
69  & ns_comm, mpi_err)
70  IF(vlactive) THEN
71  CALL mpi_bcast(bcastbuf, bufsize, mpi_real8, 0,
72  & vac_comm, mpi_err)
73  END IF
74  CALL second0(tbroadoff)
75  broadcast_time = broadcast_time + (tbroadoff -tbroadon)
76 
77  mn=0
78  DO n1 = 1, 3*ntmax
79  DO m = 0, mpol1
80  DO n = 0, ntor
81  mn = mn + 1
82  rzl_array(n,m,js,n1) = bcastbuf(mn)
83  END DO
84  END DO
85  END DO
86  DEALLOCATE(bcastbuf)
87 #endif
88 
89  rmncc = rcc
90  rmnss = rss
91  rmnsc = rsc
92  rmncs = rcs
93  zmnsc = zsc + ntmax
94  zmncc = zcc + ntmax
95  zmncs = zcs + ntmax
96  zmnss = zss + ntmax
97  lmnsc = zsc + 2*ntmax
98  lmncc = zcc + 2*ntmax
99  lmncs = zcs + 2*ntmax
100  lmnss = zss + 2*ntmax
101 
102 !
103 ! DO M = 0 MODES SEPARATELY (ONLY KEEP N >= 0 HERE: COS(-NV), SIN(-NV))
104 !
105  mn = 0; m = 0
106  zmns(1:ntor+1) = 0; lmns(1:ntor+1) = 0
107  DO n = 0, ntor
108  t1 = mscale(m)*nscale(n)
109  mn = mn + 1
110  rmnc(mn) = t1*rzl_array(n,m,js,rmncc)
111  IF (.not. lthreed) cycle
112  zmns(mn) =-t1*rzl_array(n,m,js,zmncs)
113  lmns(mn) =-t1*rzl_array(n,m,js,lmncs)
114  END DO
115 
116  lmns(1) = 0 !may have been used for storing iota variation...
117 
118  DO m = 1, mpol1
119  DO n = -ntor, ntor
120  n1 = abs(n)
121  t1 = mscale(m)*nscale(n1)
122  mn = mn + 1
123  IF (n .eq. 0) THEN
124  rmnc(mn) = t1*rzl_array(n,m,js,rmncc)
125  zmns(mn) = t1*rzl_array(n,m,js,zmnsc)
126  lmns(mn) = t1*rzl_array(n,m,js,lmnsc)
127  ELSE IF (js .gt. 1) THEN
128  sign0 = n/n1
129  IF (.not.lthreed) sign0 = 0
130  rmnc(mn) = p5*t1*(rzl_array(n1,m,js,rmncc) +
131  & sign0*rzl_array(n1,m,js,rmnss))
132  zmns(mn) = p5*t1*(rzl_array(n1,m,js,zmnsc) -
133  & sign0*rzl_array(n1,m,js,zmncs))
134  lmns(mn) = p5*t1*(rzl_array(n1,m,js,lmnsc) -
135  & sign0*rzl_array(n1,m,js,lmncs))
136  ELSE IF (js .eq. 1) THEN
137  rmnc(mn) = 0
138  zmns(mn) = 0
139  lmns(mn) = 0
140  END IF
141  END DO
142  END DO
143 
144  IF (mn .ne. mnmax) stop 'Error in Convert!'
145 
146  IF (.not.lasym) THEN
147  rmns = 0
148  zmnc = 0
149  lmnc = 0
150  RETURN
151  END IF
152 
153  mn = 0; m = 0
154  rmns(1:ntor+1) = 0
155  DO n = 0, ntor
156  t1 = mscale(m)*nscale(n)
157  mn = mn + 1
158  zmnc(mn) = t1*rzl_array(n,m,js,zmncc)
159  lmnc(mn) = t1*rzl_array(n,m,js,lmncc)
160  IF (.not.lthreed) cycle
161  rmns(mn) =-t1*rzl_array(n,m,js,rmncs) !ers-fixed sign
162  END DO
163 
164  mul1 = 1
165  IF (.not.lthreed) mul1 = 0
166  DO m = 1, mpol1
167  DO n = -ntor, ntor
168  n1 = abs(n)
169  t1 = mscale(m)*nscale(n1)
170  mn = mn + 1
171  IF (n .eq. 0) THEN
172  rmns(mn) = t1*rzl_array(n,m,js,rmnsc)
173  zmnc(mn) = t1*rzl_array(n,m,js,zmncc)
174  lmnc(mn) = t1*rzl_array(n,m,js,lmncc)
175  ELSE IF (js .gt. 1) THEN
176  sign0 = n/n1
177  rmns(mn) = p5*t1*(mul1*rzl_array(n1,m,js,rmnsc) -
178  & sign0*rzl_array(n1,m,js,rmncs))
179  zmnc(mn) = p5*t1*(mul1*rzl_array(n1,m,js,zmncc) +
180  & sign0*rzl_array(n1,m,js,zmnss))
181  lmnc(mn) = p5*t1*(mul1*rzl_array(n1,m,js,lmncc) +
182  & sign0*rzl_array(n1,m,js,lmnss))
183  ELSE IF (js .eq. 1) THEN
184  rmns(mn) = 0
185  zmnc(mn) = 0
186  lmnc(mn) = 0
187  END IF
188  END DO
189  END DO
190 
191  END SUBROUTINE convert_par
192 
193 !-------------------------------------------------------------------------------
213 !-------------------------------------------------------------------------------
214  SUBROUTINE convert(rmnc, zmns, lmns,
215  & rmns, zmnc, lmnc,
216  & rzl_array, js)
217  USE vmec_main
218  USE vmec_params
219  USE parallel_include_module
220  IMPLICIT NONE
221 C-----------------------------------------------
222 C D u m m y A r g u m e n t s
223 C-----------------------------------------------
224  INTEGER, INTENT(IN) :: js
225  REAL(dp), DIMENSION(mnmax), INTENT(out) ::
226  & rmnc, zmns, lmns, rmns, zmnc, lmnc
227  REAL(dp), DIMENSION(ns,0:ntor,0:mpol1,3*ntmax),
228  & INTENT(in) :: rzl_array
229 C-----------------------------------------------
230 C L o c a l P a r a m e t e r s
231 C-----------------------------------------------
232  REAL(dp), PARAMETER :: p5 = 0.5_dp
233 C-----------------------------------------------
234 C L o c a l V a r i a b l e s
235 C-----------------------------------------------
236  INTEGER :: rmncc, rmnss, rmncs, rmnsc, zmncs, zmnsc,
237  & zmncc, zmnss, lmncs, lmnsc, lmncc, lmnss
238  INTEGER :: mn, m, n, n1
239  REAL(dp) :: t1, sign0, mul1
240 C-----------------------------------------------
241 !
242 ! CONVERTS INTERNAL MODE REPRESENTATION TO STANDARD
243 ! FORM FOR OUTPUT (COEFFICIENTS OF COS(mu-nv), SIN(mu-nv) WITHOUT mscale,nscale norms)
244 !
245  rmncc = rcc
246  rmnss = rss
247  rmnsc = rsc
248  rmncs = rcs
249  zmnsc = zsc + ntmax
250  zmncc = zcc + ntmax
251  zmncs = zcs + ntmax
252  zmnss = zss + ntmax
253  lmnsc = zsc + 2*ntmax
254  lmncc = zcc + 2*ntmax
255  lmncs = zcs + 2*ntmax
256  lmnss = zss + 2*ntmax
257 
258 !
259 ! DO M = 0 MODES SEPARATELY (ONLY KEEP N >= 0 HERE: COS(-NV), SIN(-NV))
260 !
261  mn = 0; m = 0
262  zmns(1:ntor+1) = 0; lmns(1:ntor+1) = 0
263  DO n = 0, ntor
264  t1 = mscale(m)*nscale(n)
265  mn = mn + 1
266  rmnc(mn) = t1*rzl_array(js,n,m,rmncc)
267  IF (.not. lthreed) cycle
268  zmns(mn) =-t1*rzl_array(js,n,m,zmncs)
269  lmns(mn) =-t1*rzl_array(js,n,m,lmncs)
270  END DO
271 
272  IF (lthreed .and. js.eq.1) THEN
273  mn = 0
274  DO n = 0, ntor
275  t1 = mscale(m)*nscale(n)
276  mn = mn + 1
277  lmns(mn) =-t1*(2*rzl_array(2,n,m,lmncs)
278  & - rzl_array(3,n,m,lmncs))
279  END DO
280  END IF
281 
282  lmns(1) = 0 !may have been used for storing iota variation...
283 
284  DO m = 1, mpol1
285  DO n = -ntor, ntor
286  n1 = abs(n)
287  t1 = mscale(m)*nscale(n1)
288  mn = mn + 1
289  IF (n .eq. 0) THEN
290  rmnc(mn) = t1*rzl_array(js,n,m,rmncc)
291  zmns(mn) = t1*rzl_array(js,n,m,zmnsc)
292  lmns(mn) = t1*rzl_array(js,n,m,lmnsc)
293  ELSE IF (js .gt. 1) THEN
294  sign0 = n/n1
295  IF (.not.lthreed) sign0 = 0
296  rmnc(mn) = p5*t1*(rzl_array(js,n1,m,rmncc) +
297  & sign0*rzl_array(js,n1,m,rmnss))
298  zmns(mn) = p5*t1*(rzl_array(js,n1,m,zmnsc) -
299  & sign0*rzl_array(js,n1,m,zmncs))
300  lmns(mn) = p5*t1*(rzl_array(js,n1,m,lmnsc) -
301  & sign0*rzl_array(js,n1,m,lmncs))
302  ELSE IF (js .eq. 1) THEN
303  rmnc(mn) = 0
304  zmns(mn) = 0
305  lmns(mn) = 0
306  END IF
307  END DO
308  END DO
309 
310  IF (mn .ne. mnmax) stop 'Error in Convert!'
311 
312  IF (.not.lasym) THEN
313  rmns = 0
314  zmnc = 0
315  lmnc = 0
316  RETURN
317  END IF
318 
319  mn = 0; m = 0
320  rmns(1:ntor+1) = 0
321  DO n = 0, ntor
322  t1 = mscale(m)*nscale(n)
323  mn = mn + 1
324  zmnc(mn) = t1*rzl_array(js,n,m,zmncc)
325  lmnc(mn) = t1*rzl_array(js,n,m,lmncc)
326  IF (.not.lthreed) cycle
327  rmns(mn) =-t1*rzl_array(js,n,m,rmncs) !ers-fixed sign
328  END DO
329 
330  mul1 = 1
331  IF (.not.lthreed) mul1 = 0
332  DO m = 1, mpol1
333  DO n = -ntor, ntor
334  n1 = abs(n)
335  t1 = mscale(m)*nscale(n1)
336  mn = mn + 1
337  IF (n .eq. 0) THEN
338  rmns(mn) = t1*rzl_array(js,n,m,rmnsc)
339  zmnc(mn) = t1*rzl_array(js,n,m,zmncc)
340  lmnc(mn) = t1*rzl_array(js,n,m,lmncc)
341  ELSE IF (js .gt. 1) THEN
342  sign0 = n/n1
343  rmns(mn) = p5*t1*(mul1*rzl_array(js,n1,m,rmnsc) -
344  & sign0*rzl_array(js,n1,m,rmncs))
345  zmnc(mn) = p5*t1*(mul1*rzl_array(js,n1,m,zmncc) +
346  & sign0*rzl_array(js,n1,m,zmnss))
347  lmnc(mn) = p5*t1*(mul1*rzl_array(js,n1,m,lmncc) +
348  & sign0*rzl_array(js,n1,m,lmnss))
349  ELSE IF (js .eq. 1) THEN
350  rmns(mn) = 0
351  zmnc(mn) = 0
352  lmnc(mn) = 0
353  END IF
354  END DO
355  END DO
356 
357  END SUBROUTINE convert
Generated on Thu Mar 5 2020 15:49:26 for V3FIT by   doxygen 1.8.17