V3FIT
allocate_ns.f
1  SUBROUTINE allocate_ns (linterp, neqs_old)
2  USE vmec_main
3  USE vmec_params, ONLY: ntmax
4  USE realspace
5  USE vforces
6  USE xstuff
7  USE csplinx
8  USE mgrid_mod
9  USE fbal
10  USE parallel_include_module
11  USE vmec_input, ONLY: nzeta
12  USE vmec_dim, ONLY: ns, ntheta3
13 
14  IMPLICIT NONE
15 C-----------------------------------------------
16 C D u m m y V a r i a b l e s
17 C-----------------------------------------------
18  INTEGER, INTENT(in) :: neqs_old
19  LOGICAL, INTENT(inout) :: linterp
20 C-----------------------------------------------
21 C L o c a l V a r i a b l e s
22 C-----------------------------------------------
23  INTEGER :: ndim, nsp1, istat1
24  REAL(rprec), DIMENSION(:), ALLOCATABLE :: xc_old, scalxc_old
25  REAL(rprec), DIMENSION(:), ALLOCATABLE :: pxc_old, pscalxc_old
26  REAL(rprec) :: delr_mse
27 C-----------------------------------------------
28 !
29 ! FIRST STORE COARSE-MESH XC FOR INTERPOLATION
30 !
31  ndim = 1 + nrzt
32  nsp1 = 1 + ns
33  delr_mse = zero
34 
35 !
36 ! Save old xc, scalxc for possible interpolation or IF iterations restarted on same mesh...
37 !
38  IF (parvmec) THEN
39  IF (neqs_old.GT.0 .AND. ALLOCATED(pscalxc) .AND. linterp) THEN
40  ALLOCATE(pxc_old(neqs_old),pscalxc_old(neqs_old),
41  & stat=istat1)
42  IF (istat1.NE.0) THEN
43  stop 'allocation error #1 in allocate_ns'
44  ENDIF
45  pxc_old(:neqs_old) = pxc(:neqs_old)
46  pscalxc_old(:neqs_old) = pscalxc(:neqs_old)
47  END IF
48  END IF
49 
50  IF (neqs_old .GT. 0 .AND. ALLOCATED(scalxc) .AND. linterp) THEN
51  ALLOCATE(xc_old(neqs_old), scalxc_old(neqs_old), stat=istat1)
52  IF (istat1.ne.0) THEN
53  stop 'allocation error #1 in allocate_ns'
54  END IF
55  xc_old(:neqs_old) = xc(:neqs_old)
56  scalxc_old(:neqs_old) = scalxc(:neqs_old)
57  END IF
58 
59 !
60 ! ALLOCATES MEMORY FOR NS-DEPENDENT ARRAYS
61 ! FIRST BE SURE TO FREE MEMORY PREVIOUSLY ALLOCATED
62 !
63  IF (parvmec) THEN
64  CALL free_mem_ns_par (.true.)
65  END IF
66  CALL free_mem_ns (.true.)
67 
68  ALLOCATE (phip(ndim), chip(ndim), shalf(ndim), sqrts(ndim),
69  1 wint(ndim), stat=istat1)
70  IF (istat1.ne.0) THEN
71  stop 'allocation error #2 in allocate_ns'
72  END IF
73  phip=0; chip=0; shalf=0; sqrts=0; wint=0
74 
75  IF(parvmec) THEN
76  ALLOCATE(pshalf(nznt,ns),stat=istat1)
77  ALLOCATE(pwint(nznt,ns),stat=istat1)
78  ALLOCATE(pwint_ns(nznt),stat=istat1)
79  ALLOCATE(ireflect_par(nzeta),stat=istat1)
80  ALLOCATE(pchip(nznt,ns),stat=istat1)
81  ALLOCATE(pphip(nznt,ns),stat=istat1)
82  ALLOCATE(psqrts(nznt,ns),stat=istat1)
83  ALLOCATE(pfaclam(0:ntor,0:mpol1,1:ns,ntmax),stat=istat1)
84  END IF
85 
86  ALLOCATE(ireflect(ns*nzeta), stat=istat1)
87  IF (istat1.ne.0) THEN
88  stop 'allocation error #3 in allocate_ns'
89  END IF
90 
91  ALLOCATE(ard(nsp1,2),arm(nsp1,2),brd(nsp1,2),brm(nsp1,2),
92  & azd(nsp1,2),azm(nsp1,2),bzd(nsp1,2), bzm(nsp1,2),
93  & sm(ns), sp(0:ns), bmin(ntheta2,ns), bmax(ntheta2,ns),
94  & stat=istat1)
95  IF (istat1.ne.0) THEN
96  stop 'allocation error #6 in allocate_ns'
97  END IF
98 
99  ALLOCATE(iotaf(nsp1), crd(nsp1), mass(ns), phi(ns), presf(ns),
100  & jcuru(ns), jcurv(ns), jdotb(ns), buco(ns), bvco(ns),
101 #ifdef _ANIMEC
102 !WAC ANISTROPIC VARIABLES
103  & phot(ns), pmap(ns), pppr(ns), papr(ns), tpotb(ns),
104  & pd(ns),
105 #endif
106  & bucof(ns), bvcof(ns), chi(ns),
107  & bdotgradv(ns), equif(ns), specw(ns), tcon(ns),
108  & psi(ns),yellip(ns),yinden(ns), ytrian(ns),yshift(ns),
109  & ygeo(ns),overr(ns), faclam(ns,0:ntor,0:mpol1,ntmax),
110  & iotas(nsp1), phips(nsp1), chips(nsp1), pres(nsp1),
111  & beta_vol(ns), jperp2(ns), jpar2(ns), bdotb(ns),
112  & phipf(ns), chipf(ns), blam(nsp1), clam(nsp1),
113  & dlam(nsp1), rru_fac(ns), rzu_fac(ns), frcc_fac(ns),
114  & fzsc_fac(ns), icurv(ns+1), vpphi(ns), bdamp(ns),
115  & presgrad(ns), vp(nsp1), r01(ns), z01(ns), stat=istat1)
116 
117  frcc_fac = 0; fzsc_fac = 0
118 #ifdef _ANIMEC
119  phot=0; tpotb=0
120 #endif
121  IF (istat1 .NE. 0) THEN
122  stop 'allocation error #7 in allocate_ns'
123  END IF
124 
125  iotaf(nsp1) = 0
126 
127  ALLOCATE(rmidx(2*ns), hmidx(2*ns), wmidx(2*ns), qmidx(2*ns),
128  1 tenmidx(2*ns), ymidx(2*ns), y2midx(2*ns), stat=istat1)
129  IF (istat1 .NE. 0) THEN
130  stop 'allocation error #8 in allocate_ns'
131  END IF
132 
133  IF(parvmec) THEN
134  ALLOCATE(pgc(neqs), pxcdot(neqs), pxsave(neqs),
135  & pxstore(neqs), pcol_scale(neqs), stat=istat1)
136  pxstore = zero
137  IF (istat1 .NE. 0) THEN
138  stop 'allocation error #9 in allocate_ns'
139  END IF
140 
141  IF (.not.ALLOCATED(pxc)) THEN
142  ALLOCATE (pxc(neqs), pscalxc(neqs), stat=istat1)
143  IF (istat1 .NE. 0) THEN
144  stop 'allocation error #10 in allocate_ns'
145  END IF
146  pxc(:neqs) = zero
147  END IF
148 
149  IF (ALLOCATED(pxc_old)) THEN
150  pxstore(1:neqs_old) = pxc_old(1:neqs_old)
151  pscalxc(1:neqs_old) = pscalxc_old(1:neqs_old)
152  DEALLOCATE (pxc_old, pscalxc_old)
153  END IF
154  END IF
155 
156  ALLOCATE(gc(neqs), xcdot(neqs), xsave(neqs),
157  & xstore(neqs), col_scale(neqs), stat=istat1)
158  xstore = zero
159  IF (istat1 .NE. 0) THEN
160  stop 'allocation error #9 in allocate_ns'
161  END IF
162 
163  IF (.NOT.ALLOCATED(xc)) THEN
164  ALLOCATE (xc(neqs), scalxc(neqs), stat=istat1)
165  IF (istat1 .NE. 0) THEN
166  stop 'allocation error #10 in allocate_ns'
167  END IF
168  xc(:neqs) = zero
169  END IF
170 
171  IF (ALLOCATED(xc_old)) THEN
172  xstore(1:neqs_old) = xc_old(1:neqs_old)
173  scalxc(1:neqs_old) = scalxc_old(1:neqs_old)
174  DEALLOCATE (xc_old, scalxc_old)
175  END IF
176 
177 !
178 ! Allocate nrzt-dependent arrays (persistent) for funct3d
179 !
180  IF (parvmec) THEN
181  CALL allocate_funct3d_par
182  ELSE
183  CALL allocate_funct3d
184  END IF
185 
186  END SUBROUTINE allocate_ns
Generated on Thu Mar 5 2020 15:49:26 for V3FIT by   doxygen 1.8.17