V3FIT
read_boozer_mod.f90
1  MODULE read_boozer_mod
2 !
3 ! USAGE:
4 !
5 ! Use READ_BOOZER_MOD to include variables dynamically ALlocated
6 ! in the module
7 ! Call DEALLOCATE_READ_BOOZER to free this memory when it is no longer needed
8 !
9  USE stel_kinds
10  IMPLICIT NONE
11 #if defined(NETCDF)
12 !-----------------------------------------------
13 ! L O C A L P A R A M E T E R S
14 !-----------------------------------------------
15 ! Variable names (vn_...) : put eventually into library, used by read_wout too...
16  CHARACTER(LEN=*), PARAMETER :: &
17  vn_nfp="nfp_b", vn_ns="ns_b", vn_aspect="aspect_b", &
18  vn_rmax="rmax_b", vn_rmin="rmin_b", vn_betaxis="betaxis_b", &
19  vn_mboz="mboz_b", vn_nboz="nboz_b", vn_mnboz="mnboz_b", &
20  vn_version="version", vn_iota="iota_b", vn_pres="pres_b", &
21  vn_beta="beta_b", vn_phip="phip_b", vn_phi="phi_b", &
22  vn_bvco="bvco_b", vn_buco="buco_b", vn_ixm="ixm_b", &
23  vn_ixn="ixn_b", vn_bmnc="bmnc_b", vn_rmnc="rmnc_b", &
24  vn_zmns="zmns_b", vn_pmns="pmns_b", vn_gmnc="gmn_b", &
25  vn_bmns="bmns_b", vn_rmns="rmns_b", vn_zmnc="zmnc_b", &
26  vn_pmnc="pmnc_b", vn_gmns="gmns_b", vn_lasym="lasym", &
27  vn_jlist="jlist"
28 #endif
29 !-----------------------------------------------
30 ! L o c a l V a r i a b l e s
31 !-----------------------------------------------
32  INTEGER :: mnboz_b, mboz_b, nboz_b, nfp_b, ns_b
33  INTEGER, DIMENSION(:), ALLOCATABLE :: idx_b, ixm_b, ixn_b
34  REAL(rprec), DIMENSION(:), ALLOCATABLE :: iota_b, pres_b, &
35  phip_b, phi_b, beta_b, buco_b, bvco_b
36  REAL(rprec) :: aspect_b, rmax_b, rmin_b, betaxis_b
37  REAL(rprec), DIMENSION(:,:), ALLOCATABLE :: &
38  bmnc_b, rmnc_b, zmns_b, pmns_b, gmnc_b, packed2d
39  REAL(rprec), DIMENSION(:,:), ALLOCATABLE :: &
40  bmns_b, rmns_b, zmnc_b, pmnc_b, gmns_b
41  LOGICAL :: lasym_b = .false.
42 
43  CONTAINS
44 
45  SUBROUTINE read_boozer_file (file_or_extension, ierr, iopen)
46  USE safe_open_mod
47  IMPLICIT NONE
48 !-----------------------------------------------
49 ! D u m m y A r g u m e n t s
50 !-----------------------------------------------
51  INTEGER :: ierr
52  INTEGER, OPTIONAL :: iopen
53  CHARACTER(LEN=*) :: file_or_extension
54 !-----------------------------------------------
55 ! L o c a l P a r a m e t e r s
56 !-----------------------------------------------
57  INTEGER, PARAMETER :: unit_booz = 14
58 !-----------------------------------------------
59 ! L o c a l V a r i a b l e s
60 !-----------------------------------------------
61  INTEGER :: iunit
62  CHARACTER(len=LEN_TRIM(file_or_extension)+10) :: filename
63  LOGICAL :: isnc
64 !-----------------------------------------------
65 !
66 ! THIS SUBROUTINE READS THE BOOZMN FILE CREATED BY THE BOOZ_XFORM CODE
67 ! AND STORES THE DATA IN THE READ_BOOZ_MOD MODULE
68 !
69 ! CHECK FOR netcdf FILE EXTENSION (*.nc)
70 !
71  filename = 'boozmn'
72  CALL parse_extension(filename, file_or_extension, isnc)
73 
74  IF (isnc) THEN
75 #if defined(NETCDF)
76  CALL read_boozer_nc(filename, ierr)
77 #else
78  print *, "NETCDF wout file can not be opened on this platform"
79  ierr = -100
80 #endif
81  ELSE
82  iunit = unit_booz
83  CALL safe_open (iunit, ierr, filename, 'old', 'unformatted')
84  IF (ierr .eq. 0) CALL read_boozer_bin(iunit, ierr)
85  CLOSE(unit=iunit)
86  END IF
87 
88  IF (PRESENT(iopen)) iopen = ierr
89 
90  END SUBROUTINE read_boozer_file
91 
92 #if defined(NETCDF)
93  SUBROUTINE read_boozer_nc(filename, ierr)
94  USE stel_constants, ONLY: zero
95  USE ezcdf
96 !-----------------------------------------------
97 ! D u m m y A r g u m e n t s
98 !-----------------------------------------------
99  INTEGER :: ierr
100  CHARACTER(LEN=*) :: filename
101 !-----------------------------------------------
102 ! L o c a l V a r i a b l e s
103 !-----------------------------------------------
104  INTEGER, DIMENSION(3) :: dimlens
105  INTEGER :: nbooz, nsval, ilist
106  INTEGER, ALLOCATABLE, DIMENSION(:) :: jlist
107  CHARACTER(LEN=38) :: version
108 !-----------------------------------------------
109 ! Open cdf File
110  call cdf_open(nbooz,filename,'r', ierr)
111  IF (ierr .ne. 0) THEN
112  print *,' Error opening boozmn .nc file'
113  RETURN
114  END IF
115 
116 ! Read in scalar variables
117  CALL cdf_read(nbooz, vn_nfp, nfp_b)
118  CALL cdf_read(nbooz, vn_ns, ns_b)
119  CALL cdf_read(nbooz, vn_aspect, aspect_b)
120  CALL cdf_read(nbooz, vn_rmax, rmax_b)
121  CALL cdf_read(nbooz, vn_rmin, rmin_b)
122  CALL cdf_read(nbooz, vn_betaxis, betaxis_b)
123  CALL cdf_read(nbooz, vn_mboz, mboz_b)
124  CALL cdf_read(nbooz, vn_nboz, nboz_b)
125  CALL cdf_read(nbooz, vn_mnboz, mnboz_b)
126  CALL cdf_read(nbooz, vn_version, version)
127  CALL cdf_read(nbooz, vn_lasym, lasym_b)
128 
129 ! 1D arrays (skip inquiry statements for now, assume correct in file)
130  IF (ALLOCATED(iota_b)) CALL read_boozer_deallocate
131  ALLOCATE (iota_b(ns_b), pres_b(ns_b), beta_b(ns_b), phip_b(ns_b), &
132  phi_b(ns_b), bvco_b(ns_b), buco_b(ns_b), idx_b(ns_b), &
133  ixm_b(mnboz_b), ixn_b(mnboz_b), stat=ierr)
134  IF (ierr .ne. 0) THEN
135  print *,' Allocation error in read_boozer_file'
136  RETURN
137  END IF
138 
139  CALL cdf_read(nbooz, vn_iota, iota_b)
140  CALL cdf_read(nbooz, vn_pres, pres_b)
141  CALL cdf_read(nbooz, vn_beta, beta_b)
142  CALL cdf_read(nbooz, vn_phip, phip_b)
143  CALL cdf_read(nbooz, vn_phi, phi_b)
144  CALL cdf_read(nbooz, vn_bvco, bvco_b)
145  CALL cdf_read(nbooz, vn_buco, buco_b)
146  CALL cdf_read(nbooz, vn_ixm, ixm_b)
147  CALL cdf_read(nbooz, vn_ixn, ixn_b)
148 
149  CALL cdf_inquire(nbooz, vn_jlist, dimlens)
150  ALLOCATE (jlist(1:dimlens(1)), stat=ierr)
151  CALL cdf_read(nbooz, vn_jlist, jlist)
152 
153  idx_b = 0
154  ilist = SIZE(jlist)
155  DO ilist = 1, SIZE(jlist)
156  nsval = jlist(ilist)
157  idx_b(nsval) = 1
158  END DO
159 
160 ! 2D arrays
161  ALLOCATE (bmnc_b(mnboz_b,ns_b), rmnc_b(mnboz_b,ns_b), &
162  zmns_b(mnboz_b,ns_b), pmns_b(mnboz_b,ns_b), &
163  gmnc_b(mnboz_b,ns_b), packed2d(mnboz_b, ilist), stat=ierr)
164  IF (ierr .ne. 0) THEN
165  print *,' Allocation error in read_boozer_file'
166  RETURN
167  END IF
168 
169 !
170 ! Note: Must unpack these 2D arrays, only jlist-ed radial nodes store in file
171 !
172  rmnc_b = 0; zmns_b = 0; pmns_b = 0; bmnc_b = 0; gmnc_b = 0
173  CALL unpack_cdf(nbooz, vn_bmnc, bmnc_b)
174  CALL unpack_cdf(nbooz, vn_rmnc, rmnc_b)
175  CALL unpack_cdf(nbooz, vn_zmns, zmns_b)
176  CALL unpack_cdf(nbooz, vn_pmns, pmns_b)
177  CALL unpack_cdf(nbooz, vn_gmnc, gmnc_b)
178 
179  IF (lasym_b) THEN
180  ALLOCATE (bmns_b(mnboz_b,ns_b), rmns_b(mnboz_b,ns_b), &
181  zmnc_b(mnboz_b,ns_b), pmnc_b(mnboz_b,ns_b), &
182  gmns_b(mnboz_b,ns_b), stat=ierr)
183  IF (ierr .ne. 0) THEN
184  print *,' Allocation error in read_boozer_file'
185  RETURN
186  END IF
187  rmns_b = 0; zmnc_b = 0; pmnc_b = 0; bmns_b = 0; gmns_b = 0
188  CALL unpack_cdf(nbooz, vn_bmns, bmns_b)
189  CALL unpack_cdf(nbooz, vn_rmns, rmns_b)
190  CALL unpack_cdf(nbooz, vn_zmnc, zmnc_b)
191  CALL unpack_cdf(nbooz, vn_pmnc, pmnc_b)
192  CALL unpack_cdf(nbooz, vn_gmns, gmns_b)
193  END IF
194 
195 
196  DEALLOCATE (jlist, packed2d)
197 
198 ! Close cdf File
199  CALL cdf_close(nbooz, ierr)
200 
201  END SUBROUTINE read_boozer_nc
202 #endif
203 
204  SUBROUTINE read_boozer_bin(iunit, ierr)
205 !-----------------------------------------------
206 ! D u m m y A r g u m e n t s
207 !-----------------------------------------------
208  INTEGER :: ierr, iunit
209 !-----------------------------------------------
210 ! L o c a l V a r i a b l e s
211 !-----------------------------------------------
212  INTEGER :: nsval, jsize, js
213  CHARACTER(LEN=38) :: version
214 !-----------------------------------------------
215 
216  READ(iunit, iostat=ierr, err=100) nfp_b, ns_b, aspect_b, &
217  rmax_b, rmin_b, betaxis_b
218 
219  IF (ALLOCATED(iota_b)) CALL read_boozer_deallocate
220  ALLOCATE (iota_b(ns_b), pres_b(ns_b), beta_b(ns_b), phip_b(ns_b), &
221  phi_b(ns_b), bvco_b(ns_b), buco_b(ns_b), idx_b(ns_b), stat=ierr)
222  IF (ierr .ne. 0) THEN
223  print *,' Allocation error in read_boozer_file'
224  RETURN
225  END IF
226 
227  iota_b(1) = 0; pres_b(1) = 0; beta_b(1) = 0
228  phip_b(1) = 0; phi_b(1) = 0; bvco_b(1) = 0
229  buco_b(1) = 0
230 
231  DO nsval = 2, ns_b
232  READ(iunit, iostat=ierr, err=100) iota_b(nsval), &
233  pres_b(nsval), beta_b(nsval), phip_b(nsval), phi_b(nsval), &
234  bvco_b(nsval), buco_b(nsval)
235  END DO
236 
237  READ(iunit, iostat=ierr, err=100) mboz_b, nboz_b, mnboz_b, jsize
238  READ(iunit, iostat=js) version, lasym_b
239 
240  ALLOCATE (bmnc_b(mnboz_b,ns_b), rmnc_b(mnboz_b,ns_b), &
241  zmns_b(mnboz_b,ns_b), pmns_b(mnboz_b,ns_b), &
242  gmnc_b(mnboz_b,ns_b), ixm_b(mnboz_b), ixn_b(mnboz_b), stat=ierr)
243  IF (ierr .ne. 0) THEN
244  print *,' Allocation error in read_boozer_file'
245  RETURN
246  END IF
247 
248  idx_b = 0
249  ixm_b = 0
250  rmnc_b = 0; zmns_b = 0; pmns_b = 0; bmnc_b = 0; gmnc_b = 0
251 
252  IF (lasym_b) THEN
253  ALLOCATE (bmns_b(mnboz_b,ns_b), rmns_b(mnboz_b,ns_b), &
254  zmnc_b(mnboz_b,ns_b), pmnc_b(mnboz_b,ns_b), &
255  gmns_b(mnboz_b,ns_b), stat=ierr)
256  IF (ierr .ne. 0) THEN
257  print *,' Allocation error in read_boozer_file'
258  RETURN
259  END IF
260 
261  rmns_b = 0; zmnc_b = 0; pmnc_b = 0; bmns_b = 0; gmns_b = 0
262 
263  END IF
264 
265 !
266 ! idx_b: = 0, surface data not in file; = 1, surface data in file
267 !
268  READ(iunit,iostat=ierr,err=100) ixn_b(:mnboz_b), ixm_b(:mnboz_b)
269 
270  DO js = 1, jsize
271  READ(iunit, iostat=ierr, END=200, err=100) nsval
272  IF ((nsval.gt.ns_b) .or. (nsval.le.0)) cycle
273 
274  idx_b(nsval) = 1
275 
276  READ(iunit,iostat=ierr,err=100, END=200) bmnc_b(:mnboz_b,nsval), &
277  rmnc_b(:mnboz_b,nsval), zmns_b(:mnboz_b,nsval), &
278  pmns_b(:mnboz_b,nsval), gmnc_b(:mnboz_b,nsval)
279 
280  IF (.not.lasym_b) cycle
281 
282  READ(iunit,iostat=ierr,err=100, END=200) bmns_b(:mnboz_b,nsval), &
283  rmns_b(:mnboz_b,nsval), zmnc_b(:mnboz_b,nsval), &
284  pmnc_b(:mnboz_b,nsval), gmns_b(:mnboz_b,nsval)
285  END DO
286 
287  100 CONTINUE
288  IF (ierr .gt. 0) THEN
289  print *,' Error reading in subroutine read_boozer_file:', &
290  ' ierr = ', ierr
291  END IF
292  200 CONTINUE
293  IF (ierr .lt. 0) ierr = 0 !End-of-file, ok
294  CLOSE(iunit)
295 
296  END SUBROUTINE read_boozer_bin
297 
298 
299  SUBROUTINE read_boozer_deallocate
300  IMPLICIT NONE
301 !-----------------------------------------------
302 ! L o c a l V a r i a b l e s
303 !-----------------------------------------------
304  INTEGER :: istat
305 !-----------------------------------------------
306 
307  IF (ALLOCATED(iota_b)) DEALLOCATE (iota_b, pres_b, beta_b, &
308  phip_b, phi_b, bvco_b, buco_b, idx_b, stat = istat)
309 
310  IF (ALLOCATED(bmnc_b)) DEALLOCATE (bmnc_b, rmnc_b, &
311  zmns_b, pmns_b, gmnc_b, ixm_b, ixn_b, stat = istat)
312 
313  IF (ALLOCATED(bmns_b)) DEALLOCATE (bmns_b, rmns_b, &
314  zmnc_b, pmnc_b, gmns_b, stat = istat)
315 
316  END SUBROUTINE read_boozer_deallocate
317 
318 
319 #if defined(NETCDF)
320  SUBROUTINE unpack_cdf (nbooz, var_name, array2d)
321  USE stel_kinds, ONLY: rprec
322  USE ezcdf
323 !-----------------------------------------------
324 ! D u m m y A r g u m e n t s
325 !-----------------------------------------------
326  INTEGER, INTENT(in) :: nbooz
327  INTEGER :: nsval, icount
328  REAL(rprec), DIMENSION(:,:), INTENT(out) :: array2d
329  CHARACTER(LEN=*), INTENT(in) :: var_name
330 !-----------------------------------------------
331 !
332 ! Read into temporary packed array, packed2d
333 !
334  CALL cdf_read(nbooz, var_name, packed2d)
335 
336  array2d = 0; icount = 1
337 
338  DO nsval = 1, ns_b
339  IF (idx_b(nsval) .eq. 1) THEN
340  array2d(:,nsval) = packed2d(:,icount)
341  icount = icount + 1
342  END IF
343  END DO
344 
345  END SUBROUTINE unpack_cdf
346 #endif
347 
348  END MODULE read_boozer_mod
Generated on Thu Mar 5 2020 15:49:23 for V3FIT by   doxygen 1.8.17