V3FIT
symforce.f
1  SUBROUTINE symforce_par(ars, brs, crs, azs, bzs, czs, bls, cls,
2  & rcs, zcs, ara, bra, cra, aza, bza, cza,
3  & bla, cla, rca, zca)
4  USE vmec_main, p5 => cp5
5  USE realspace, ONLY: ireflect_par
6  USE parallel_include_module
7  USE timer_sub
8  IMPLICIT NONE
9 C-----------------------------------------------
10 C D u m m y A r g u m e n t s
11 C-----------------------------------------------
12  REAL(dp), DIMENSION(nzeta,ntheta3,ns,0:1),
13  & INTENT(inout) :: ars, brs, crs, azs, bzs, czs,
14  & bls, cls, rcs, zcs
15  REAL(dp), DIMENSION(nzeta,ntheta3,ns,0:1), INTENT(out) ::
16  & ara, bra, cra, aza, bza, cza, bla, cla, rca, zca
17 C-----------------------------------------------
18 C L o c a l V a r i a b l e s
19 C-----------------------------------------------
20  INTEGER :: mpar, ir, i, jk, jka
21  REAL(dp), DIMENSION(:,:), ALLOCATABLE :: ars_0, brs_0, azs_0,
22  & bzs_0, bls_0, rcs_0, zcs_0, crs_0, czs_0, cls_0
23  INTEGER :: nsmin, nsmax, j, k
24 C-----------------------------------------------
25  CALL second0(tforon)
26  nsmin=t1lglob
27  nsmax=t1rglob
28 
29  ALLOCATE (ars_0(nzeta,ns), brs_0(nzeta,ns), azs_0(nzeta,ns),
30  & bzs_0(nzeta,ns), bls_0(nzeta,ns), rcs_0(nzeta,ns),
31  & zcs_0(nzeta,ns), crs_0(nzeta,ns), czs_0(nzeta,ns),
32  & cls_0(nzeta,ns), stat=ir)
33 
34 !
35 ! SYMMETRIZE FORCES ON RESTRICTED THETA INTERVAL (0 <= u <= pi)
36 ! SO COS,SIN INTEGRALS CAN BE PERFORMED. FOR EXAMPLE,
37 !
38 ! ARS(v,u) = .5*( ARS(v,u) + ARS(-v,-u) ) ! * COS(mu - nv)
39 ! ARA(v,u) = .5*( ARS(v,u) - ARS(-v,-u) ) ! * SIN(mu - nv)
40 !
41 !
42  DO k = nsmin, nsmax
43  DO mpar = 0, 1
44  DO i = 1, ntheta2
45  ir = ntheta1 + 2 - i !-theta
46  IF (i .eq. 1) THEN
47  ir = 1
48  END IF
49  DO j = 1, nzeta
50  jka = ireflect_par(j) !-zeta
51  ara(j,i,k,mpar) = p5*(ars(j,i,k,mpar) -
52  & ars(jka,ir,k,mpar))
53  ars_0(j,k) = p5*(ars(j,i,k,mpar) +
54  & ars(jka,ir,k,mpar))
55  bra(j,i,k,mpar) = p5*(brs(j,i,k,mpar) +
56  & brs(jka,ir,k,mpar))
57  brs_0(j,k) = p5*(brs(j,i,k,mpar) -
58  & brs(jka,ir,k,mpar))
59  aza(j,i,k,mpar) = p5*(azs(j,i,k,mpar) +
60  & azs(jka,ir,k,mpar))
61  azs_0(j,k) = p5*(azs(j,i,k,mpar) -
62  & azs(jka,ir,k,mpar))
63  bza(j,i,k,mpar) = p5*(bzs(j,i,k,mpar) -
64  & bzs(jka,ir,k,mpar))
65  bzs_0(j,k) = p5*(bzs(j,i,k,mpar) +
66  & bzs(jka,ir,k,mpar))
67  bla(j,i,k,mpar) = p5*(bls(j,i,k,mpar) -
68  & bls(jka,ir,k,mpar))
69  bls_0(j,k) = p5*(bls(j,i,k,mpar) +
70  & bls(jka,ir,k,mpar))
71  rca(j,i,k,mpar) = p5*(rcs(j,i,k,mpar) -
72  & rcs(jka,ir,k,mpar))
73  rcs_0(j,k) = p5*(rcs(j,i,k,mpar) +
74  & rcs(jka,ir,k,mpar))
75  zca(j,i,k,mpar) = p5*(zcs(j,i,k,mpar) +
76  & zcs(jka,ir,k,mpar))
77  zcs_0(j,k) = p5*(zcs(j,i,k,mpar) -
78  & zcs(jka,ir,k,mpar))
79  END DO
80 
81  ars(:,i,k,mpar) = ars_0(:,k)
82  brs(:,i,k,mpar) = brs_0(:,k)
83  azs(:,i,k,mpar) = azs_0(:,k)
84  bzs(:,i,k,mpar) = bzs_0(:,k)
85  bls(:,i,k,mpar) = bls_0(:,k)
86  rcs(:,i,k,mpar) = rcs_0(:,k)
87  zcs(:,i,k,mpar) = zcs_0(:,k)
88 
89  IF (lthreed) THEN
90  DO j = 1, nzeta
91  jka = ireflect_par(j)
92  cra(j,i,k,mpar)= p5*(crs(j,i,k,mpar) +
93  & crs(jka,ir,k,mpar))
94  crs_0(j,k) = p5*(crs(j,i,k,mpar) -
95  & crs(jka,ir,k,mpar))
96  cza(j,i,k,mpar)= p5*(czs(j,i,k,mpar) -
97  & czs(jka,ir,k,mpar))
98  czs_0(j,k) = p5*(czs(j,i,k,mpar) +
99  & czs(jka,ir,k,mpar))
100  cla(j,i,k,mpar)= p5*(cls(j,i,k,mpar) -
101  & cls(jka,ir,k,mpar))
102  cls_0(j,k) = p5*(cls(j,i,k,mpar) +
103  & cls(jka,ir,k,mpar))
104  END DO
105 
106  crs(:,i,k,mpar) = crs_0(:,k)
107  czs(:,i,k,mpar) = czs_0(:,k)
108  cls(:,i,k,mpar) = cls_0(:,k)
109  END IF
110 
111  END DO
112  END DO
113  END DO
114 
115  DEALLOCATE (ars_0, brs_0, azs_0, bzs_0, bls_0,
116  1 rcs_0, zcs_0, crs_0, czs_0, cls_0, stat=ir)
117 
118  CALL second0(tforoff)
119  symforces_time = symforces_time + (tforoff - tforon)
120  timer(tfor) = timer(tfor) + (tforoff - tforon)
121 
122  END SUBROUTINE symforce_par
123 
124  SUBROUTINE symforce(ars, brs, crs, azs, bzs, czs, bls, cls, rcs,
125  & zcs, ara, bra, cra, aza, bza, cza, bla, cla,
126  & rca, zca)
127  USE vmec_main, p5 => cp5
128  USE parallel_include_module
129  USE timer_sub
130  IMPLICIT NONE
131 C-----------------------------------------------
132 C D u m m y A r g u m e n t s
133 C-----------------------------------------------
134  REAL(dp), DIMENSION(ns*nzeta,ntheta3,0:1), INTENT(inout) ::
135  & ars, brs, crs, azs, bzs, czs, bls, cls, rcs, zcs
136  REAL(dp), DIMENSION(ns*nzeta,ntheta3,0:1), INTENT(out) ::
137  & ara, bra, cra, aza, bza, cza, bla, cla, rca, zca
138 C-----------------------------------------------
139 C L o c a l V a r i a b l e s
140 C-----------------------------------------------
141  INTEGER :: mpar, ir, i, jk, jka
142  REAL(dp), DIMENSION(:), ALLOCATABLE :: ars_0, brs_0, azs_0,
143  & bzs_0, bls_0, rcs_0, zcs_0, crs_0, czs_0, cls_0
144 C-----------------------------------------------
145  CALL second0(tforon)
146  i = ns*nzeta
147  ALLOCATE (ars_0(i), brs_0(i), azs_0(i), bzs_0(i), bls_0(i),
148  & rcs_0(i), zcs_0(i), crs_0(i), czs_0(i), cls_0(i),
149  & stat=ir)
150 
151 !
152 ! SYMMETRIZE FORCES ON RESTRICTED THETA INTERVAL (0 <= u <= pi)
153 ! SO COS,SIN INTEGRALS CAN BE PERFORMED. FOR EXAMPLE,
154 !
155 ! ARS(v,u) = .5*( ARS(v,u) + ARS(-v,-u) ) ! * COS(mu - nv)
156 ! ARA(v,u) = .5*( ARS(v,u) - ARS(-v,-u) ) ! * SIN(mu - nv)
157 !
158 !
159  DO mpar = 0, 1
160  DO i = 1, ntheta2
161  ir = ntheta1 + 2 - i !-theta
162  IF (i .eq. 1) THEN
163  ir = 1
164  END IF
165  DO jk = 1, ns*nzeta
166  jka = ireflect(jk) !-zeta
167  ara(jk,i,mpar) = p5*(ars(jk,i,mpar) - ars(jka,ir,mpar))
168  ars_0(jk) = p5*(ars(jk,i,mpar) + ars(jka,ir,mpar))
169  bra(jk,i,mpar) = p5*(brs(jk,i,mpar) + brs(jka,ir,mpar))
170  brs_0(jk) = p5*(brs(jk,i,mpar) - brs(jka,ir,mpar))
171  aza(jk,i,mpar) = p5*(azs(jk,i,mpar) + azs(jka,ir,mpar))
172  azs_0(jk) = p5*(azs(jk,i,mpar) - azs(jka,ir,mpar))
173  bza(jk,i,mpar) = p5*(bzs(jk,i,mpar) - bzs(jka,ir,mpar))
174  bzs_0(jk) = p5*(bzs(jk,i,mpar) + bzs(jka,ir,mpar))
175  bla(jk,i,mpar) = p5*(bls(jk,i,mpar) - bls(jka,ir,mpar))
176  bls_0(jk) = p5*(bls(jk,i,mpar) + bls(jka,ir,mpar))
177  rca(jk,i,mpar) = p5*(rcs(jk,i,mpar) - rcs(jka,ir,mpar))
178  rcs_0(jk) = p5*(rcs(jk,i,mpar) + rcs(jka,ir,mpar))
179  zca(jk,i,mpar) = p5*(zcs(jk,i,mpar) + zcs(jka,ir,mpar))
180  zcs_0(jk) = p5*(zcs(jk,i,mpar) - zcs(jka,ir,mpar))
181  END DO
182 
183  ars(:,i,mpar) = ars_0(:)
184  brs(:,i,mpar) = brs_0(:)
185  azs(:,i,mpar) = azs_0(:)
186  bzs(:,i,mpar) = bzs_0(:)
187  bls(:,i,mpar) = bls_0(:)
188  rcs(:,i,mpar) = rcs_0(:)
189  zcs(:,i,mpar) = zcs_0(:)
190 
191  IF (lthreed) THEN
192  DO jk = 1, ns*nzeta
193  jka = ireflect(jk)
194  cra(jk,i,mpar) = p5*(crs(jk,i,mpar) +
195  & crs(jka,ir,mpar))
196  crs_0(jk) = p5*(crs(jk,i,mpar) -
197  & crs(jka,ir,mpar))
198  cza(jk,i,mpar) = p5*(czs(jk,i,mpar) -
199  & czs(jka,ir,mpar))
200  czs_0(jk) = p5*(czs(jk,i,mpar) +
201  & czs(jka,ir,mpar))
202  cla(jk,i,mpar) = p5*(cls(jk,i,mpar) -
203  & cls(jka,ir,mpar))
204  cls_0(jk) = p5*(cls(jk,i,mpar) +
205  & cls(jka,ir,mpar))
206  END DO
207 
208  crs(:,i,mpar) = crs_0(:)
209  czs(:,i,mpar) = czs_0(:)
210  cls(:,i,mpar) = cls_0(:)
211  END IF
212 
213  END DO
214  END DO
215 
216  DEALLOCATE (ars_0, brs_0, azs_0, bzs_0, bls_0,
217  1 rcs_0, zcs_0, crs_0, czs_0, cls_0, stat=ir)
218 
219 
220  CALL second0(tforoff)
221  s_symforces_time = s_symforces_time + (tforoff - tforon)
222  timer(tfor) = timer(tfor) + (tforoff - tforon)
223 
224  END SUBROUTINE symforce
225 
226  SUBROUTINE symoutput(bsq, gsqrt , bsubu , bsubv ,bsupu,
227  & bsupv, bsubs,
228 #ifdef _ANIMEC
229  & ppar, pperp, densit, sigma_an, tau_an,
230  & pbprim, ppprim,
231 #endif
232  & bsqa, gsqrta, bsubua, bsubva, bsupua,
233  & bsupva, bsubsa
234 #ifdef _ANIMEC
235  & , ppara, pperpa, densita, sigma_ana, tau_ana,
236  & pbprima, ppprima
237 #endif
238  & )
239 
240  USE vmec_main, p5 => cp5
241  IMPLICIT NONE
242 C-----------------------------------------------
243 C D u m m y A r g u m e n t s
244 C-----------------------------------------------
245  REAL(dp), DIMENSION(ns*nzeta,ntheta3), INTENT(inout) ::
246  & bsq, gsqrt, bsubu, bsubv, bsupu, bsupv, bsubs
247 #ifdef _ANIMEC
248  REAL(dp), DIMENSION(ns*nzeta,ntheta3), INTENT(inout) ::
249  & ppar, pperp, sigma_an, tau_an, pbprim, ppprim, densit
250 #endif
251  REAL(dp), DIMENSION(ns*nzeta,ntheta3), INTENT(out) ::
252  & bsqa,gsqrta,bsubua,bsubva,bsupua,bsupva,bsubsa
253 #ifdef _ANIMEC
254  REAL(dp), DIMENSION(ns*nzeta,ntheta3), INTENT(out) ::
255  & ppara, pperpa, sigma_ana, tau_ana, pbprima, ppprima,
256  & densita
257 #endif
258 C-----------------------------------------------
259 C L o c a l V a r i a b l e s
260 C-----------------------------------------------
261  INTEGER :: ir, i, jk, jka
262  REAL(dp), DIMENSION(ns*nzeta) :: bsq_0, gsqrt_0, bsubu_0,
263  & bsubv_0, bsupu_0, bsupv_0, bsubs_0
264 #ifdef _ANIMEC
265  REAL(dp), DIMENSION(ns*nzeta) :: ppar_0, pperp_0,
266  & sigma_an0 , tau_an0 , pbprim_0, ppprim_0, densit_0
267 #endif
268 C-----------------------------------------------
269 
270 !
271 ! SYMMETRIZE FORCES ON RESTRICTED THETA INTERVAL (0 <= u <= pi)
272 ! SO COS,SIN INTEGRALS CAN BE PERFORMED. FOR EXAMPLE,
273 !
274 ! BSQ-S(v,u) = .5*( BSQ(v,u) + BSQ(-v,-u) ) ! * COS(mu - nv)
275 ! BSQ-A(v,u) = .5*( BSQ(v,u) - BSQ(-v,-u) ) ! * SIN(mu - nv)
276 !
277 ! FOR BSUBS, THIS IS REVERSED, S-PIECE ~ SIN, A-PIECE ~ COS
278 !
279 !
280  DO i = 1, ntheta2
281  ir = ntheta1 + 2 - i !-theta
282  IF (i == 1) THEN
283  ir = 1
284  END IF
285  DO jk = 1, ns*nzeta
286  jka = ireflect(jk) !-zeta
287  bsqa(jk,i) = p5*(bsq(jk,i) - bsq(jka,ir))
288  bsq_0(jk) = p5*(bsq(jk,i) + bsq(jka,ir))
289  gsqrta(jk,i) = p5*(gsqrt(jk,i) - gsqrt(jka,ir))
290  gsqrt_0(jk) = p5*(gsqrt(jk,i) + gsqrt(jka,ir))
291  bsubua(jk,i) = p5*(bsubu(jk,i) - bsubu(jka,ir))
292  bsubu_0(jk) = p5*(bsubu(jk,i) + bsubu(jka,ir))
293  bsubva(jk,i) = p5*(bsubv(jk,i) - bsubv(jka,ir))
294  bsubv_0(jk) = p5*(bsubv(jk,i) + bsubv(jka,ir))
295  bsupua(jk,i) = p5*(bsupu(jk,i) - bsupu(jka,ir))
296  bsupu_0(jk) = p5*(bsupu(jk,i) + bsupu(jka,ir))
297  bsupva(jk,i) = p5*(bsupv(jk,i) - bsupv(jka,ir))
298  bsupv_0(jk) = p5*(bsupv(jk,i) + bsupv(jka,ir))
299 #ifdef _ANIMEC
300  sigma_ana(jk,i) = p5*(sigma_an(jk,i) - sigma_an(jka,ir))
301  sigma_an0(jk) = p5*(sigma_an(jk,i) + sigma_an(jka,ir))
302  tau_ana(jk,i) = p5*(tau_an(jk,i) - tau_an(jka,ir))
303  tau_an0(jk) = p5*(tau_an(jk,i) + tau_an(jka,ir))
304  ppara(jk,i) = p5*(ppar(jk,i) - ppar(jka,ir))
305  ppar_0(jk) = p5*(ppar(jk,i) + ppar(jka,ir))
306  pperpa(jk,i) = p5*(pperp(jk,i) - pperp(jka,ir))
307  pperp_0(jk) = p5*(pperp(jk,i) + pperp(jka,ir))
308  pbprima(jk,i) = p5*(pbprim(jk,i) - pbprim(jka,ir))
309  pbprim_0(jk) = p5*(pbprim(jk,i) + pbprim(jka,ir))
310  ppprima(jk,i) = p5*(ppprim(jk,i) - ppprim(jka,ir))
311  ppprim_0(jk) = p5*(ppprim(jk,i) + ppprim(jka,ir))
312  densita(jk,i) = p5*(densit(jk,i) - densit(jka,ir))
313  densit_0(jk) = p5*(densit(jk,i) + densit(jka,ir))
314 #endif
315 ! Dominant symmetry reversed
316  bsubsa(jk,i) = p5*(bsubs(jk,i) + bsubs(jka,ir))
317  bsubs_0(jk) = p5*(bsubs(jk,i) - bsubs(jka,ir))
318  END DO
319 
320  bsq(:,i) = bsq_0(:)
321  gsqrt(:,i) = gsqrt_0(:)
322  bsubu(:,i) = bsubu_0(:)
323  bsubv(:,i) = bsubv_0(:)
324  bsupu(:,i) = bsupu_0(:)
325  bsupv(:,i) = bsupv_0(:)
326  bsubs(:,i) = bsubs_0(:)
327 #ifdef _ANIMEC
328  sigma_an(:,i) = sigma_an0(:)
329  tau_an(:,i) = tau_an0(:)
330  ppar(:,i) = ppar_0(:)
331  pperp(:,i) = pperp_0(:)
332  pbprim(:,i) = pbprim_0(:)
333  ppprim(:,i) = ppprim_0(:)
334  densit(:,i) = densit_0(:)
335 #endif
336 
337  END DO
338 
339  END SUBROUTINE symoutput
340 
341 ! Put the surface routines in a separate subroutine since these the quantites
342 ! these work on only exist on free boundary runs.
343  SUBROUTINE symoutput_sur(bsubu, bsubv, bsupu, bsupv, &
344  & bsubua, bsubva, bsupua, bsupva)
345  USE vmec_main, p5 => cp5
346 
347  IMPLICIT NONE
348 
349 C-----------------------------------------------
350 C D u m m y A r g u m e n t s
351 C-----------------------------------------------
352  REAL(dp), DIMENSION(nzeta,ntheta3), INTENT(inout) ::
353  1 bsubu, bsubv, bsupu, bsupv
354  REAL(dp), DIMENSION(nzeta,ntheta2), INTENT(out) ::
355  1 bsubua, bsubva, bsupua, bsupva
356 
357 C-----------------------------------------------
358 C L o c a l V a r i a b l e s
359 C-----------------------------------------------
360  INTEGER :: ir, i, jk, jka
361  REAL(dp), DIMENSION(nzeta) :: bsubu_0, bsubv_0,
362  1 bsupu_0, bsupv_0
363 C-----------------------------------------------
364 
365 !
366 ! SYMMETRIZE FORCES ON RESTRICTED THETA INTERVAL (0 <= u <= pi)
367 ! SO COS,SIN INTEGRALS CAN BE PERFORMED. FOR EXAMPLE,
368 !
369 ! BSQ-S(v,u) = .5*( BSQ(v,u) + BSQ(-v,-u) ) ! * COS(mu - nv)
370 ! BSQ-A(v,u) = .5*( BSQ(v,u) - BSQ(-v,-u) ) ! * SIN(mu - nv)
371 !
372 ! FOR BSUBS, THIS IS REVERSED, S-PIECE ~ SIN, A-PIECE ~ COS
373 !
374 !
375 
376  ir = 1 !-theta
377  DO i = 1, ntheta2
378  jka = 1 !-zeta
379  DO jk = 1, nzeta
380  bsubua(jk,i) = p5*(bsubu(jk,i) - bsubu(jka,ir))
381  bsubu_0(jk) = p5*(bsubu(jk,i) + bsubu(jka,ir))
382  bsubva(jk,i) = p5*(bsubv(jk,i) - bsubv(jka,ir))
383  bsubv_0(jk) = p5*(bsubv(jk,i) + bsubv(jka,ir))
384  bsupua(jk,i) = p5*(bsupu(jk,i) - bsupu(jka,ir))
385  bsupu_0(jk) = p5*(bsupu(jk,i) + bsupu(jka,ir))
386  bsupva(jk,i) = p5*(bsupv(jk,i) - bsupv(jka,ir))
387  bsupv_0(jk) = p5*(bsupv(jk,i) + bsupv(jka,ir))
388  jka = nzeta - jk + 1
389 
390  END DO
391  ir = ntheta3 - i + 1
392 
393  bsubu(:,i) = bsubu_0(:)
394  bsubv(:,i) = bsubv_0(:)
395  bsupu(:,i) = bsupu_0(:)
396  bsupv(:,i) = bsupv_0(:)
397 
398  END DO
399 
400  END SUBROUTINE symoutput_sur
Generated on Thu Mar 5 2020 15:49:26 for V3FIT by   doxygen 1.8.17