1 SUBROUTINE allocate_ns (linterp, neqs_old)
3 USE vmec_params,
ONLY: ntmax
10 USE parallel_include_module
11 USE vmec_input,
ONLY: nzeta
12 USE vmec_dim,
ONLY: ns, ntheta3
18 INTEGER,
INTENT(in) :: neqs_old
19 LOGICAL,
INTENT(inout) :: linterp
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
39 IF (neqs_old.GT.0 .AND.
ALLOCATED(pscalxc) .AND. linterp)
THEN
40 ALLOCATE(pxc_old(neqs_old),pscalxc_old(neqs_old),
43 stop
'allocation error #1 in allocate_ns'
45 pxc_old(:neqs_old) = pxc(:neqs_old)
46 pscalxc_old(:neqs_old) = pscalxc(:neqs_old)
50 IF (neqs_old .GT. 0 .AND.
ALLOCATED(scalxc) .AND. linterp)
THEN
51 ALLOCATE(xc_old(neqs_old), scalxc_old(neqs_old), stat=istat1)
53 stop
'allocation error #1 in allocate_ns'
55 xc_old(:neqs_old) = xc(:neqs_old)
56 scalxc_old(:neqs_old) = scalxc(:neqs_old)
64 CALL free_mem_ns_par (.true.)
66 CALL free_mem_ns (.true.)
68 ALLOCATE (phip(ndim), chip(ndim), shalf(ndim), sqrts(ndim),
69 1 wint(ndim), stat=istat1)
71 stop
'allocation error #2 in allocate_ns'
73 phip=0; chip=0; shalf=0; sqrts=0; wint=0
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)
86 ALLOCATE(ireflect(ns*nzeta), stat=istat1)
88 stop
'allocation error #3 in allocate_ns'
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),
96 stop
'allocation error #6 in allocate_ns'
99 ALLOCATE(iotaf(nsp1), crd(nsp1), mass(ns), phi(ns), presf(ns),
100 & jcuru(ns), jcurv(ns), jdotb(ns), buco(ns), bvco(ns),
103 & phot(ns), pmap(ns), pppr(ns), papr(ns), tpotb(ns),
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)
117 frcc_fac = 0; fzsc_fac = 0
121 IF (istat1 .NE. 0)
THEN
122 stop
'allocation error #7 in allocate_ns'
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'
134 ALLOCATE(pgc(neqs), pxcdot(neqs), pxsave(neqs),
135 & pxstore(neqs), pcol_scale(neqs), stat=istat1)
137 IF (istat1 .NE. 0)
THEN
138 stop
'allocation error #9 in allocate_ns'
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'
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)
156 ALLOCATE(gc(neqs), xcdot(neqs), xsave(neqs),
157 & xstore(neqs), col_scale(neqs), stat=istat1)
159 IF (istat1 .NE. 0)
THEN
160 stop
'allocation error #9 in allocate_ns'
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'
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)
181 CALL allocate_funct3d_par
183 CALL allocate_funct3d
186 END SUBROUTINE allocate_ns