V3FIT
boozer_xform.f
1  PROGRAM boozer_xform
2  USE booz_params
3  USE safe_open_mod
4  IMPLICIT NONE
5 C-----------------------------------------------
6 C L o c a l V a r i a b l e s
7 C-----------------------------------------------
8  INTEGER :: istat, jrad, iread, numargs, jsurf
9  REAL(rprec) :: t1, t2
10  CHARACTER(LEN=50) :: arg1, arg2
11  CHARACTER(LEN=120) :: extension
12 C-----------------------------------------------
13 !
14 ! driver: reads from command line file the wout file extension and surfaces
15 ! (half-radial) at which the boozer coordinates are required
16 ! writes the boozer coordinates to a file, boozmn.extension
17 !
18 ! call this as follows:
19 !
20 ! xbooz_xform input.boz [T or F]
21 !
22 ! WHERE input.boz CONTAINS the mboz, nboz, wout file extension and the jrad values (as a
23 ! blank-delimited list, not necessarily on a single line):
24 !
25 ! mboz nboz
26 ! FILE_EXTENSION (does NOT have to include the .nc or .txt extension for netcdf,text file)
27 ! 1 3 5 10 12
28 !
29 ! The OPTIONAL command line argument, (T) or (F), Allows the user to turn off screen
30 ! output IF set to F.
31 !
32 ! CALL xbooz_xform -h brings up a help screen
33 !
34  lscreen = .true. !!Default, write to screen
35 
36 !
37 ! Read command line argument to get input file name
38 !
39  CALL getcarg(1, arg1, numargs)
40  IF (numargs .gt. 1) CALL getcarg(2, arg2, numargs)
41 
42  IF (numargs .lt. 1) THEN
43  print *,'Invalid command line in calling xbooz_xform'
44  print *,'Type xbooz_xform -h to get more information'
45  stop
46  ELSE IF (arg1 .eq. '-h' .or. arg1 .eq. '/h') THEN
47  print *,' ENTER INPUT FILE NAME ON COMMAND LINE'
48  print *,' For example: xbooz_xform in_booz.ext'
49  print *
50  print *,' WHERE in_booz.ext is the input file'
51  print *
52  print *,' Optional command line argument'
53  print *,' xbooz_xform <infile> (T or F)'
54  print *
55  print *,' where F suppresses output to the screen'
56  stop
57  ELSE IF (numargs .gt. 1) THEN
58  IF (arg2(1:1).eq.'f' .or. arg2(1:1).eq.'F') lscreen = .false.
59  ENDIF
60 
61  iread = unit_booz-1
62  CALL safe_open (iread, istat, trim(arg1), 'old', 'formatted')
63  IF (istat .ne. 0) stop 'Error opening input file in booz_xform'
64 
65  READ (iread, *, iostat = istat) mboz, nboz
66  READ (iread, *, iostat = istat) extension
67  IF (istat .ne. 0) stop 'Error reading input file in booz_xform'
68 
69 !
70 ! READ IN PARAMETERS, DATA FROM WOUT FILE
71 !
72  CALL read_wout_booz(extension, iread, istat)
73  IF (istat .ne. 0) THEN
74  print *,' ierr_vmec !=0 in booz_xform read_wout_booz'
75  GOTO 1010
76  END IF
77 
78  CLOSE (unit=iread)
79  CALL second0(t1)
80 
81 !
82 ! COMPUTE BOOZER TRANSFORM, SURFACE BY SURFACE
83 !
84  DO jrad = 1, ns
85  IF (lsurf_boz(jrad)) CALL boozer_coords(jrad)
86  END DO
87 
88 ! CRCook for debugging purposes
89  OPEN(unit = 16, file = 'sum_gmncb.txt')
90  jsurf=0
91  DO jrad = 1, ns
92  IF (lsurf_boz(jrad)) THEN
93  jsurf=jsurf+1
94  WRITE(16,*) jrad, sum(gmncb(:,jsurf))
95  END IF
96  ENDDO
97  CLOSE(16)
98 
99 ! CRCook if LRFP = T, compute chip and chi
100  IF (lrfp_b) THEN
101  chip = hiota*phip
102  DO jrad = 1, ns
103  chi(jrad) = chip(jrad)*(jrad-1)/(ns-1)
104  ENDDO
105  ENDIF
106 
107  !
108  ! WRITE OUT CONVERTED RESULTS
109  !
110  CALL write_boozmn(extension)
111 
112  1010 CONTINUE
113 !
114 ! FREE MEMORY : USER MUST CALL BOOZER_COORDS AT END WITH LDEALLOC = TRUE
115 ! OTHERWISE MEMORY ALLOCATED WILL NOT BE AVAILABLE
116 !
117 
118  CALL free_mem_boozer
119 
120  CALL second0(t2)
121 
122  IF (lscreen) print 120, t2-t1
123  120 FORMAT(/,' TIME IN BOOZER TRANSFORM CODE:',1pe12.2,' SEC')
124 
125  END PROGRAM boozer_xform