V3FIT
load_xc_from_wout.f
1  SUBROUTINE load_xc_from_wout(rmn, zmn, lmn, lreset,
2  1 ntor_in, mpol1_in, ns_in, reset_file)
3  USE read_wout_mod, ONLY: rmnc, zmns, lmns, rmns, zmnc, lmnc,
4  1 xm, xn, ntor, ns,
5  2 nfp, mnmax, read_wout_file, read_wout_deallocate
6  USE vmec_params, ONLY: mscale, nscale, ntmax,
7  1 rcc, rss, rsc, rcs, zsc, zcs, zcc, zss
8  USE vmec_dim, ONLY: mpol1
9  USE vparams, ONLY: one, zero, rprec
10  USE vmec_input, ONLY: lasym
11  USE vmec_main, ONLY: lthreed, p5 => cp5, sp, sm, phipf
12  USE parallel_include_module, ONLY: rank
13  IMPLICIT NONE
14 C-----------------------------------------------
15 C D u m m y A r g u m e n t s
16 C-----------------------------------------------
17  INTEGER :: ns_in, mpol1_in, ntor_in
18  REAL(rprec), DIMENSION(ns_in,0:ntor_in,0:mpol1_in,ntmax),
19  1 INTENT(out) :: rmn, zmn, lmn
20  LOGICAL, INTENT(out) :: lreset
21  CHARACTER(LEN=*) :: reset_file
22 C-----------------------------------------------
23 C L o c a l V a r i a b l e s
24 C-----------------------------------------------
25  INTEGER :: ierr, mn, m, n, n1, js
26  REAL(rprec) :: t1, t2
27  REAL(rprec), ALLOCATABLE :: temp(:,:)
28 C-----------------------------------------------
29 
30 !
31 ! THIS ALLOWS SEQUENTIAL RUNNING OF VMEC FROM THE COMMAND LINE
32 ! i.e., WHEN VMEC INTERNAL ARRAYS ARE NOT KEPT IN MEMORY (compared to sequence file input)
33 ! THIS IS THE CASE WHEN VMEC IS CALLED FROM, SAY, THE OPTIMIZATION CODE
34 !
35 ! SPH 12-13-11: allow for paths in wout file name (as per Ed Lazarus request)
36  CALL read_wout_file (reset_file, ierr)
37 ! CALL read_wout_file (reset_file(5:), ierr)
38  reset_file = " " !nullify so this routine will not be recalled with present reset_file
39 
40  IF (ierr .ne. 0.AND.rank.EQ.0) THEN
41  print *,' Error opening/reading wout file in VMEC load_xc!'
42  RETURN
43  END IF
44 
45  IF (ns_in .ne. ns.AND.rank.EQ.0) THEN
46  print *, 'ns_in (passed to load_xc) != ns (from reading wout)'
47  RETURN
48  END IF
49 
50  IF (ntor_in .ne. ntor ) stop 'ntor_in != ntor in load_xc'
51  IF (mpol1_in .ne. mpol1) stop 'mpol1_in != mpol1 in load_xc'
52  IF (nfp .eq. 0) stop 'nfp = 0 in load_xc'
53 
54  lreset = .false. !Signals profil3d NOT to overwrite axis values
55 
56  rmn = zero
57  zmn = zero
58  lmn = zero
59 
60  DO mn = 1, mnmax
61  m = nint(xm(mn))
62  n = nint(xn(mn))/nfp
63  n1 = abs(n)
64  t1 = one/(mscale(m)*nscale(n1))
65  t2 = t1
66  IF (n .lt. 0) t2 = -t2
67  IF (n .eq. 0) t2 = zero
68  rmn(:ns,n1,m,rcc) = rmn(:ns,n1,m,rcc) + t1*rmnc(mn,:ns)
69  zmn(:ns,n1,m,zsc) = zmn(:ns,n1,m,zsc) + t1*zmns(mn,:ns)
70  lmn(:ns,n1,m,zsc) = lmn(:ns,n1,m,zsc) + t1*lmns(mn,:ns)
71  IF (lthreed) THEN
72  rmn(:ns,n1,m,rss) = rmn(:ns,n1,m,rss) + t2*rmnc(mn,:ns)
73  zmn(:ns,n1,m,zcs) = zmn(:ns,n1,m,zcs) - t2*zmns(mn,:ns)
74  lmn(:ns,n1,m,zcs) = lmn(:ns,n1,m,zcs) - t2*lmns(mn,:ns)
75  END IF
76  IF (lasym) THEN
77  rmn(:ns,n1,m,rsc) = rmn(:ns,n1,m,rsc) + t1*rmns(mn,:ns)
78  zmn(:ns,n1,m,zcc) = zmn(:ns,n1,m,zcc) + t1*zmnc(mn,:ns)
79  lmn(:ns,n1,m,zcc) = lmn(:ns,n1,m,zcc) + t1*lmnc(mn,:ns)
80  IF (lthreed) THEN
81  rmn(:ns,n1,m,rcs) = rmn(:ns,n1,m,rcs) - t2*rmns(mn,:ns)
82  zmn(:ns,n1,m,zss) = zmn(:ns,n1,m,zss) + t2*zmnc(mn,:ns)
83  lmn(:ns,n1,m,zss) = lmn(:ns,n1,m,zss) + t2*lmnc(mn,:ns)
84  END IF
85  END IF
86  IF (m .eq. 0) THEN
87  zmn(:ns,n1,m,zsc) = zero
88  lmn(:ns,n1,m,zsc) = zero
89  IF (lthreed) rmn(:ns,n1,m,rss) = zero
90  IF (lasym) THEN
91  rmn(:ns,n1,m,rsc) = zero
92  IF (lthreed) THEN
93  zmn(:ns,n1,m,zss) = zero
94  lmn(:ns,n1,m,zss) = zero
95  END IF
96  END IF
97  END IF
98  END DO
99 
100 !
101 ! CONVERT TO INTERNAL FORM FOR (CONSTRAINED) m=1 MODES
102 !
103 
104  IF (lthreed .or. lasym) ALLOCATE (temp(ns_in,0:ntor_in))
105  IF (lthreed) THEN
106  temp = rmn(:,:,1,rss)
107  rmn(:,:,1,rss) = p5*(temp + zmn(:,:,1,zcs))
108  zmn(:,:,1,zcs) = p5*(temp - zmn(:,:,1,zcs))
109  END IF
110  IF (lasym) THEN
111  temp = rmn(:,:,1,rsc)
112  rmn(:,:,1,rsc) = p5*(temp + zmn(:,:,1,zcc))
113  zmn(:,:,1,zcc) = p5*(temp - zmn(:,:,1,zcc))
114  END IF
115 
116  IF (ALLOCATED(temp)) DEALLOCATE (temp)
117 
118 !
119 ! CONVERT lambda TO INTERNAL FULL MESH REPRESENTATION
120 !
121 ! START ITERATION AT JS=1
122 !
123  lmn(1,:,0,:) = lmn(2,:,0,:)
124  lmn(1,:,1,:) = 2*lmn(2,:,1,:)/(sm(2) + sp(1))
125  lmn(1,:,2:,:) = 0
126 
127  DO m = 0, mpol1, 2
128  DO js = 2, ns
129  lmn(js,:,m,:) = 2*lmn(js,:,m,:) - lmn(js-1,:,m,:)
130  END DO
131  END DO
132 
133  DO m = 1, mpol1, 2
134  DO js = 2, ns
135  lmn(js,:,m,:) = (2*lmn(js,:,m,:)
136  1 - sp(js-1)*lmn(js-1,:,m,:))/sm(js)
137  END DO
138  END DO
139 
140  DO js = 2, ns
141  lmn(js,:,:,:) = phipf(js)*lmn(js,:,:,:)
142  END DO
143 
144  CALL read_wout_deallocate
145 
146  END SUBROUTINE load_xc_from_wout