V3FIT
allocate_funct3d.f
1  SUBROUTINE allocate_funct3d_par
2  USE vmec_main
3  USE realspace
4  USE vforces
5  USE vacmod
6  USE vmec_input, ONLY: nzeta
7  USE vmec_dim, ONLY: ns, ntheta3
8 
9  IMPLICIT NONE
10 C-----------------------------------------------
11 C L o c a l V a r i a b l e s
12 C-----------------------------------------------
13  INTEGER :: istat1, ndim, ndim2
14 C-----------------------------------------------
15  CALL free_mem_funct3d_par
16 
17  ALLOCATE(parmn(nznt,ns,0:1),stat=istat1)
18  ALLOCATE(pazmn(nznt,ns,0:1),stat=istat1)
19  ALLOCATE(pbrmn(nznt,ns,0:1),stat=istat1)
20  ALLOCATE(pbzmn(nznt,ns,0:1),stat=istat1)
21  ALLOCATE(pcrmn(nznt,ns,0:1),stat=istat1)
22  ALLOCATE(pczmn(nznt,ns,0:1),stat=istat1)
23  ALLOCATE(pblmn(nznt,ns,0:1),stat=istat1)
24  ALLOCATE(pclmn(nznt,ns,0:1),stat=istat1)
25 
26  ALLOCATE(pru(nznt,ns,0:1),stat=istat1)
27  ALLOCATE(pr1(nznt,ns,0:1),stat=istat1)
28 
29  ALLOCATE(prv(nznt,ns,0:1),stat=istat1)
30  ALLOCATE(pzv(nznt,ns,0:1),stat=istat1)
31 
32  ALLOCATE(prcon(nznt,ns,0:1),stat=istat1)
33  ALLOCATE(pzcon(nznt,ns,0:1),stat=istat1)
34 
35 !SPH CHANGE (add =0)
36  ALLOCATE(pgcon(nznt,ns),stat=istat1)
37  ALLOCATE(prcon0(nznt,ns),stat=istat1); prcon0 = 0
38  ALLOCATE(pzcon0(nznt,ns),stat=istat1); pzcon0 = 0
39 
40  ALLOCATE(pzu(nznt,ns,0:1),stat=istat1)
41  ALLOCATE(pz1(nznt,ns,0:1),stat=istat1)
42 
43  ALLOCATE(pguu(nznt,ns),stat=istat1)
44  ALLOCATE(pguv(nznt,ns),stat=istat1)
45  ALLOCATE(pgvv(nznt,ns),stat=istat1)
46 
47  ALLOCATE(pru0(nznt,ns),stat=istat1)
48  ALLOCATE(pzu0(nznt,ns),stat=istat1)
49 
50  ALLOCATE (pextra1(nznt,ns,0:1), stat=istat1)
51  IF (istat1.ne.0) stop 'allocation error #3 in allocate_funct3d'
52  pextra1=0
53 
54  IF (lasym) THEN
55  ALLOCATE (pextra2(nznt,ns,0:1),
56  & pextra3(nznt,ns,0:1),
57  & pextra4(nznt,ns,0:1),stat=istat1)
58  ELSE
59  ALLOCATE (pextra2(nznt,ns,1),
60  & pextra3(nznt,ns,1),
61  & pextra4(nznt,ns,1),stat=istat1)
62  END IF
63  IF (istat1.ne.0) stop 'allocation error #3 in allocate_funct3dpar'
64  pextra2=0; pextra3=0; pextra4=0
65 
66 !
67 ! Pointer alias assignments
68 ! NOTE: In FORCES, X_e(nrzt+1) overlaps X_o(1), which should never be used...
69 !
70  parmn_e => parmn(:,:,0)
71  parmn_o => parmn(:,:,1)
72  parmn = zero
73 
74  pazmn_e => pazmn(:,:,0)
75  pazmn_o => pazmn(:,:,1)
76  pazmn = zero
77 
78  pbrmn_e => pbrmn(:,:,0)
79  pbrmn_o => pbrmn(:,:,1)
80  pbrmn = zero
81 
82  pbzmn_e => pbzmn(:,:,0)
83  pbzmn_o => pbzmn(:,:,1)
84  pbzmn = zero
85 
86  pcrmn_e => pcrmn(:,:,0)
87  pcrmn_o => pcrmn(:,:,1)
88  pcrmn = zero
89 
90  pczmn_e => pczmn(:,:,0)
91  pczmn_o => pczmn(:,:,1)
92  pczmn = zero
93 
94  pblmn_e => pblmn(:,:,0)
95  pblmn_o => pblmn(:,:,1)
96  pblmn = zero
97 
98  pclmn_e => pclmn(:,:,0)
99  pclmn_o => pclmn(:,:,1)
100  pclmn = zero
101 
102  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
103  ndim = 1+nrzt
104  ndim2 = 2*ndim
105  CALL free_mem_funct3d
106 
107  ALLOCATE (armn(ndim2), azmn(ndim2), brmn(ndim2), bzmn(ndim2),
108  & crmn(ndim2), czmn(ndim2), blmn(ndim2), clmn(ndim2),
109  & r1(nrzt,0:1), ru(nrzt,0:1), rv(nrzt,0:1),
110  & z1(nrzt,0:1), zu(nrzt,0:1), zv(nrzt,0:1),
111  & rcon(nrzt,0:1), zcon(nrzt,0:1), ru0(ndim), zu0(ndim),
112  & rcon0(ndim), zcon0(ndim), guu(ndim), guv(ndim),
113  & gvv(ndim), gcon(ndim), sigma_an(nrzt), stat=istat1)
114  IF (istat1.ne.0) THEN
115  stop 'allocation error #1 in allocate_funct3d'
116  END IF
117  armn=0; azmn=0; brmn=0; bzmn=0; crmn=0; czmn=0; blmn=0; clmn=0
118  r1=0; ru=0; rv=0; z1=0; zu=0; zv=0; rcon=0; zcon=0
119  ru0=0; zu0=0; rcon0=0; zcon=0; guu=0; guv=0; gvv=0
120  sigma_an=1
121 
122 #ifdef _ANIMEC
123  ALLOCATE(pperp(nrzt), ppar(nrzt), onembc(nrzt),
124  & pp1(nrzt), pp2(nrzt), pp3(nrzt), stat=istat1)
125  IF (istat1.ne.0) THEN
126  stop 'allocation error #1A in allocate_funct3d'
127  END IF
128  pperp=0; ppar=0; onembc=0; pp1=0; pp2=0; pp3=0
129 #endif
130 
131  IF (lfreeb) THEN
132  ALLOCATE (brv(nznt), bphiv(nznt), bzv(nznt), bsqvac(nznt),
133  & bsqvac0(nznt), bsubu_sur(nuv3), bsubv_sur(nuv3), !MRC 10-15-15
134  & bsupu_sur(nuv3), bsupv_sur(nuv3),
135  & stat=istat1)
136  IF (istat1.ne.0) THEN
137  stop 'allocation error #2 in allocate_funct3d'
138  END IF
139  brv=0; bphiv=0; bzv=0; bsqvac=0
140  END IF
141 
142  ALLOCATE (extra1(ndim,0:1), stat=istat1)
143  IF (istat1.ne.0) THEN
144  stop 'allocation error #3 in allocate_funct3d'
145  END IF
146  extra1=0
147 
148  IF (lasym) THEN
149  ALLOCATE (extra2(ndim,0:1), extra3(ndim,0:1),
150  1 extra4(ndim,0:1),stat=istat1)
151  ELSE
152  ALLOCATE (extra2(ndim,1), extra3(ndim,1), extra4(ndim,1),
153  1 stat=istat1)
154  END IF
155  IF (istat1.ne.0) THEN
156  stop 'allocation error #3 in allocate_funct3d'
157  END IF
158  extra2=0; extra3=0; extra4=0
159 
160 !
161 ! Pointer alias assignments
162 ! NOTE: In FORCES, X_e(nrzt+1) overlaps X_o(1), which should never be used...
163 !
164  armn_e => armn(:ndim)
165  armn_o => armn(ndim:)
166  armn(:ndim2) = zero
167  brmn_e => brmn(:ndim)
168  brmn_o => brmn(ndim:)
169  brmn(:ndim2) = zero
170  azmn_e => azmn(:ndim)
171  azmn_o => azmn(ndim:)
172  azmn(:ndim2) = zero
173  bzmn_e => bzmn(:ndim)
174  bzmn_o => bzmn(ndim:)
175  bzmn(:ndim2) = zero
176  crmn_e => crmn(:ndim)
177  crmn_o => crmn(ndim:)
178  crmn(:ndim2) = zero
179  czmn_e => czmn(:ndim)
180  czmn_o => czmn(ndim:)
181  czmn(:ndim2) = zero
182  blmn_e => blmn(:ndim)
183  blmn_o => blmn(ndim:)
184  blmn(:ndim2) = zero
185  clmn_e => clmn(:ndim)
186  clmn_o => clmn(ndim:)
187  clmn(:ndim2) = zero
188  rcon0(:ndim) = zero
189  zcon0(:ndim) = zero
190 
191  END SUBROUTINE allocate_funct3d_par
192 
193  SUBROUTINE allocate_funct3d
194  USE vmec_main
195  USE realspace
196  USE vforces
197  USE vacmod
198  IMPLICIT NONE
199 C-----------------------------------------------
200 C L o c a l V a r i a b l e s
201 C-----------------------------------------------
202  INTEGER :: istat1, ndim, ndim2
203 C-----------------------------------------------
204  ndim = 1 + nrzt
205  ndim2 = 2*ndim
206 
207  CALL free_mem_funct3d
208 
209  ALLOCATE (armn(ndim2), azmn(ndim2), brmn(ndim2), bzmn(ndim2),
210  & crmn(ndim2), czmn(ndim2), blmn(ndim2), clmn(ndim2),
211  & r1(nrzt,0:1), ru(nrzt,0:1), rv(nrzt,0:1),
212  & z1(nrzt,0:1), zu(nrzt,0:1), zv(nrzt,0:1),
213  & rcon(nrzt,0:1), zcon(nrzt,0:1), ru0(ndim), zu0(ndim),
214  & rcon0(ndim), zcon0(ndim), guu(ndim), guv(ndim),
215  & gvv(ndim), gcon(ndim), sigma_an(nrzt), stat=istat1)
216  IF (istat1.ne.0) THEN
217  stop 'allocation error #1 in allocate_funct3d'
218  END IF
219  armn=0; azmn=0; brmn=0; bzmn=0; crmn=0; czmn=0; blmn=0; clmn=0
220  r1=0; ru=0; rv=0; z1=0; zu=0; zv=0; rcon=0; zcon=0
221  ru0=0; zu0=0; rcon0=0; zcon=0; guu=0; guv=0; gvv=0
222  sigma_an=1
223 
224 #ifdef _ANIMEC
225  ALLOCATE(pperp(nrzt), ppar(nrzt), onembc(nrzt),
226  & pp1(nrzt), pp2(nrzt), pp3(nrzt), stat=istat1)
227  IF (istat1.ne.0) THEN
228  stop 'allocation error #1A in allocate_funct3d'
229  END IF
230  pperp=0; ppar=0; onembc=0; pp1=0; pp2=0; pp3=0
231 #endif
232 
233  IF (lfreeb) THEN
234  ALLOCATE (brv(nznt), bphiv(nznt), bzv(nznt), bsqvac(nznt),
235  & bsubu_sur(nznt), bsubv_sur(nznt), !MRC 10-15-15
236  & bsupu_sur(nznt), bsupv_sur(nznt),
237  & stat=istat1)
238  IF (istat1.ne.0) THEN
239  stop 'allocation error #2 in allocate_funct3d'
240  END IF
241  brv=0; bphiv=0; bzv=0; bsqvac=0
242  END IF
243 
244  ALLOCATE (extra1(ndim,0:1), stat=istat1)
245  IF (istat1.ne.0) THEN
246  stop 'allocation error #3 in allocate_funct3d'
247  END IF
248  extra1=0
249 
250  IF (lasym) THEN
251  ALLOCATE (extra2(ndim,0:1), extra3(ndim,0:1),
252  & extra4(ndim,0:1),stat=istat1)
253  ELSE
254  ALLOCATE (extra2(ndim,1), extra3(ndim,1), extra4(ndim,1),
255  & stat=istat1)
256  END IF
257  IF (istat1.ne.0) stop 'allocation error #3 in allocate_funct3d'
258  extra2=0; extra3=0; extra4=0
259 !
260 ! Pointer alias assignments
261 ! NOTE: In FORCES, X_e(nrzt+1) overlaps X_o(1), which should never be used...
262 !
263  armn_e => armn(:ndim)
264  armn_o => armn(ndim:)
265  armn(:ndim2) = zero
266  brmn_e => brmn(:ndim)
267  brmn_o => brmn(ndim:)
268  brmn(:ndim2) = zero
269  azmn_e => azmn(:ndim)
270  azmn_o => azmn(ndim:)
271  azmn(:ndim2) = zero
272  bzmn_e => bzmn(:ndim)
273  bzmn_o => bzmn(ndim:)
274  bzmn(:ndim2) = zero
275  crmn_e => crmn(:ndim)
276  crmn_o => crmn(ndim:)
277  crmn(:ndim2) = zero
278  czmn_e => czmn(:ndim)
279  czmn_o => czmn(ndim:)
280  czmn(:ndim2) = zero
281  blmn_e => blmn(:ndim)
282  blmn_o => blmn(ndim:)
283  blmn(:ndim2) = zero
284  clmn_e => clmn(:ndim)
285  clmn_o => clmn(ndim:)
286  clmn(:ndim2) = zero
287  rcon0(:ndim) = zero
288  zcon0(:ndim) = zero
289 
290  END SUBROUTINE allocate_funct3d
Generated on Thu Mar 5 2020 15:49:26 for V3FIT by   doxygen 1.8.17