V3FIT
v3rfun.f
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
2 ! The @header2, @begin_table, @item3 and @end_table commands are custom defined
3 ! commands in Doxygen.in. They are defined under ALIASES. For the page created
4 ! here, the 80 column limit is exceeded. Arguments of aliases are separated by
5 ! ','. If you intended ',' to be a string you must use an escaped comma '\,'.
6 !
26 !-------------------------------------------------------------------------------
27 !*******************************************************************************
30 !
31 ! Note separating the Doxygen comment block here so detailed decription is
32 ! found in the Module not the file.
33 !
48 !*******************************************************************************
49 !*******************************************************************************
50 ! MAIN PROGRAM
51 !*******************************************************************************
52 !-------------------------------------------------------------------------------
56 !-------------------------------------------------------------------------------
57  PROGRAM v3rfun
58  USE v3rfun_context
59  USE profiler
60  USE v3_utilities
61 !$ USE omp_lib
62 
63  IMPLICIT NONE
64 
65 ! local variables
66 ! Forward declare the v3rfun_parse_command_line function.
67  INTERFACE
68  FUNCTION v3rfun_parse_command_line()
69  USE v3rfun_input
70  IMPLICIT NONE
71  CHARACTER (len=v3rfun_file_length) :: v3rfun_parse_command_line
72  END FUNCTION
73  END INTERFACE
74 
75  TYPE (v3rfun_context_class), POINTER :: context => null()
76  TYPE (diagnostic_dot_coil), POINTER :: head
77  INTEGER :: id_num
78 #if defined(mpi_opt)
79  INTEGER :: error
80 
81 ! Start of executable code
82 ! The Intel version of the MPI libraries does not provide a correct value for
83 ! time until after MPI_INIT is called. Make sure this is the first think called
84 ! so that correct timing information can be used.
85  CALL mpi_init(error)
86 #endif
87 
89 
90 !$ CALL OMP_SET_NUM_THREADS(OMP_GET_NUM_PROCS())
91 !$OMP PARALLEL
92 !$ error = OMP_GET_MAX_THREADS()
93 !$OMP END PARALLEL
94 !$ WRITE (*,*) error
95 
96  context => &
98 
99 ! Compute the coil response functions.
100  head => context%coils
101  id_num = 1
102  DO WHILE(ASSOCIATED(head))
103  SELECT CASE (head%d_type)
104 
105  CASE ('flux_loop', 'flux_loop_circular', 'magnetic_probe', &
106  & 'magnetic_probe_tokamak', 'b_rogowski', 'i_rogowski', &
107  & 'f_rogowski','s_rogowski')
108  CALL v3rfun_context_write_mrf(context, head, id_num)
109 
110  CASE ('b_point_probe')
111  CALL v3rfun_context_write_point(context, head, id_num)
112 
113  CASE DEFAULT
114  CALL err_fatal('Unknown magnetic diagnostic type.')
115 
116  END SELECT
117 
118  head => head%next
119  id_num = id_num + 1
120  END DO
121 
122  CALL v3rfun_context_destruct(context)
123 
124  CALL profiler_destruct
125 
126 #if defined(MPI_OPT)
127  CALL mpi_finalize(error)
128 #endif
129 
130  END PROGRAM v3rfun
131 
132 !-------------------------------------------------------------------------------
140 !-------------------------------------------------------------------------------
141  FUNCTION v3rfun_parse_command_line()
143 
144  IMPLICIT NONE
145 
146 ! Declare Arguments
147  CHARACTER (len=v3rfun_file_length) :: v3rfun_parse_command_line
148 
149 ! local variables
150  INTEGER :: num_args, i
151  REAL (rprec) :: start_time
152 
153 ! Start of executable code
154  start_time = profiler_get_start_time()
155 
156 ! Read the zeroith arg to get the number of arguments. This should also be the
157 ! command name.
158  CALL getcarg(0, v3rfun_parse_command_line, num_args)
159 
160  IF (num_args .le. 0 .or. num_args .gt. 2) THEN
161  CALL v3rfun_print_help
162  END IF
163 
164  DO i = 1, num_args
165  CALL getcarg(i, v3rfun_parse_command_line, num_args)
166  IF (trim(v3rfun_parse_command_line) .eq. '-h') THEN
167  CALL v3rfun_print_help
168  END IF
169  END DO
170 
171  CALL profiler_set_stop_time('v3rfun_parse_command_line', &
172  & start_time)
173 
174  END FUNCTION
175 
176 !-------------------------------------------------------------------------------
183 !-------------------------------------------------------------------------------
184  SUBROUTINE v3rfun_print_help()
187 
188  IMPLICIT NONE
189 
190 ! Start of executable code
191 ! All command line messages need to fit within this width.
192 ! ' s c '
193  WRITE(*,*) ' '
194  WRITE(*,1000) code_name
195  WRITE(*,1100) magnetic_response_current
196  WRITE(*,*) ' '
197  WRITE(*,*) 'Usage: xv3rfun [-arg] filename ... '
198  WRITE(*,*) ' '
199  WRITE(*,*) 'Options: '
200  WRITE(*,*) 'All options are displayed as [arg][takesoption][text]'
201  WRITE(*,*) ' -h N Display this information '
202  WRITE(*,*) ' '
203 
204  stop
205 
206 1000 FORMAT('Code: ',a)
207 1100 FORMAT('Version: ',a)
208 
209  END SUBROUTINE
v3rfun_print_help
subroutine v3rfun_print_help()
Print out help text.
Definition: v3rfun.f:185
profiler
Defines functions for measuring an tabulating performance of function and subroutine calls....
Definition: profiler.f:13
profiler::profiler_destruct
subroutine profiler_destruct()
Deconstruct a profiler.
Definition: profiler.f:91
v3rfun_context::v3rfun_context_class
Base class representing a v3rfun context. This contains all memory needed to operate v3rfun.
Definition: v3rfun_context.f:33
v3rfun_parse_command_line
character(len=v3rfun_file_length) function v3rfun_parse_command_line()
Parse command line arguments.
Definition: v3rfun.f:142
v3rfun_context::code_name
character(len= *), parameter code_name
Name of this code.
Definition: v3rfun_context.f:22
v3rfun_context::v3rfun_context_destruct
subroutine v3rfun_context_destruct(this)
Deconstruct a v3rfun_context_class object.
Definition: v3rfun_context.f:455
v3rfun_context::v3rfun_context_write_mrf
subroutine v3rfun_context_write_mrf(this, d_coil, id_num)
Write out a magnetic coil response function.
Definition: v3rfun_context.f:533
v3rfun_context::v3rfun_context_write_point
subroutine v3rfun_context_write_point(this, d_coil, id_num)
Write out a point probe response.
Definition: v3rfun_context.f:803
v3rfun_input
This file contains all the variables and maximum sizes of the inputs for a V3RFUN namelist input file...
Definition: v3rfun_input.f:112
v3rfun_context
Defines a v3rfun_context_class object to contain all the memory for running v3rfun.
Definition: v3rfun_context.f:11
profiler::profiler_construct
subroutine profiler_construct()
Construct a profiler.
Definition: profiler.f:67
v3rfun_context::v3rfun_context_construct
type(v3rfun_context_class) function, pointer v3rfun_context_construct(filename)
Construct a v3rfun_context_class object.
Definition: v3rfun_context.f:99
magnetic_response
Defines the base class of the type magnetic_response_class.
Definition: magnetic_response.f:11
magnetic_response::magnetic_response_current
character(len= *), parameter magnetic_response_current
Version for the MDSIG files. This version adds the point diagnostics.
Definition: magnetic_response.f:28
v3rfun
program v3rfun
The V3RFUN code is part of a suite of codes, called V3FIT, designed for equilibrium reconstruction of...
Definition: v3rfun.f:57