Branch data Line data Source code
1 : : !!****m* ABINIT/m_argparse
2 : : !! NAME
3 : : !! m_argparse
4 : : !!
5 : : !! FUNCTION
6 : : !! Simple argument parser used in main programs
7 : : !!
8 : : !! COPYRIGHT
9 : : !! Copyright (C) 2008-2026 ABINIT group (MG)
10 : : !! This file is distributed under the terms of the
11 : : !! GNU General Public License, see ~abinit/COPYING
12 : : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : : !!
14 : : !! SOURCE
15 : :
16 : : #if defined HAVE_CONFIG_H
17 : : #include "config.h"
18 : : #endif
19 : :
20 : : #include "abi_common.h"
21 : :
22 : : module m_argparse
23 : :
24 : : use defs_basis
25 : : use m_abicore
26 : : use m_errors
27 : : use m_xmpi
28 : : use m_xomp
29 : : use m_xieee
30 : : use m_abi_linalg
31 : : use m_fft
32 : : use m_exit
33 : : use m_clib
34 : : use m_nctk
35 : :
36 : : use m_build_info, only : dump_config, abinit_version
37 : : use m_io_tools, only : open_file, file_exists, enforce_fortran_io
38 : : use m_cppopts_dumper, only : dump_cpp_options
39 : : use m_optim_dumper, only : dump_optim
40 : : use m_fstrings, only : atoi, atof, itoa, ftoa, firstchar, startswith, endswith, sjoin, find_and_select
41 : : use m_time, only : str2sec
42 : : use m_libpaw_tools, only : libpaw_log_flag_set
43 : : use m_ipi, only : ipi_setup
44 : : use m_bz_mesh, only : kpath_t
45 : :
46 : : implicit none
47 : :
48 : : private
49 : :
50 : : public :: get_arg ! Parse scalar argument from command line. Return exit code.
51 : :
52 : : interface get_arg
53 : : module procedure get_arg_int
54 : : module procedure get_arg_dp
55 : : module procedure get_arg_str
56 : : module procedure get_arg_bool
57 : : end interface get_arg
58 : :
59 : : public :: get_arg_list ! Parse array argument from command line. Return exit code.
60 : :
61 : : interface get_arg_list
62 : : module procedure get_arg_list_int
63 : : module procedure get_arg_list_dp
64 : : end interface get_arg_list
65 : :
66 : : public :: get_start_step_num ! Parse string from command line in the format "start:step:num"
67 : : ! defining an arithmetic progression.
68 : : public :: parse_kargs ! Parse command line arguments, return options related to k-point sampling
69 : : public :: parse_kpath_args ! Parse command line arguments, return a k-path.
70 : : public :: parse_skw_params ! Parse command line arguments, return the parameters of the SKW interpolation.
71 : :
72 : : integer,private,parameter :: MAX_KPATH_NPTS = 100
73 : : ! Max number of vertices in a k-path given on the command line.
74 : : !!***
75 : :
76 : : !!****t* m_argparse/args_t
77 : : !! NAME
78 : : !! args_t
79 : : !!
80 : : !! FUNCTION
81 : : !! Stores command line options
82 : : !!
83 : : !! SOURCE
84 : :
85 : : type,public :: args_t
86 : :
87 : : integer :: exit = 0
88 : : ! /=0 to exit after having parsed the command line options.
89 : :
90 : : integer :: abimem_level = 0
91 : : ! Options for memory profiling. See m_profiling_abi
92 : :
93 : : integer :: dry_run = 0
94 : : ! /= 0 to exit after the validation of the input file.
95 : :
96 : : real(dp) :: abimem_limit_mb = 20.0_dp
97 : : ! Optional memory limit in Mb. used when abimem_level == 3
98 : :
99 : : character(len=500) :: cmdline = ""
100 : : ! The entire command line
101 : :
102 : : character(len=fnlen) :: input_path = ""
103 : :
104 : : !! Below are for multibinit
105 : : integer :: multibinit_F03_mode = 0
106 : : !1: legacy mode
107 : : !0: use full F03 implementation mode
108 : : ! TODO: It will be deprecated when everything is ready in and the new mode will be default.
109 : :
110 : : end type args_t
111 : :
112 : : public :: args_parser ! Parse command line options.
113 : : !!***
114 : :
115 : : !!****t* m_argparse/cmd_opt_t
116 : : !! NAME
117 : : !! cmd_opt_t
118 : : !!
119 : : !! FUNCTION
120 : : !! Metadata of a command-line option of a command: used for the help and to reject unknown options.
121 : : !!
122 : : !! SOURCE
123 : :
124 : : type,public :: cmd_opt_t
125 : :
126 : : character(len=24) :: name = ""
127 : : ! Name of the option without the leading --.
128 : :
129 : : character(len=24) :: metavar = ""
130 : : ! Placeholder for the value in the help, e.g. "INT". Empty for a flag.
131 : :
132 : : character(len=24) :: default = ""
133 : : ! Default value as shown in the help. Empty if there is no default.
134 : :
135 : : character(len=100) :: help = ""
136 : : ! One-line description.
137 : :
138 : : end type cmd_opt_t
139 : : !!***
140 : :
141 : : !!****t* m_argparse/cmd_t
142 : : !! NAME
143 : : !! cmd_t
144 : : !!
145 : : !! FUNCTION
146 : : !! Metadata of a command of a main program with sub-commands (e.g. `abitk ebands_gaps FILE`):
147 : : !! usage, summary, positional arguments, options and files written.
148 : : !! The main program defines its commands, shows their help and rejects unknown options with it.
149 : : !!
150 : : !! SOURCE
151 : :
152 : : type,public :: cmd_t
153 : :
154 : : character(len=24) :: name = ""
155 : : ! Name of the command.
156 : :
157 : : character(len=24) :: group = ""
158 : : ! Group used by the main program to sort the commands in the global help.
159 : :
160 : : character(len=160) :: usage = ""
161 : : ! Usage without the name of the program, e.g. "ebands_gaps FILE".
162 : :
163 : : character(len=160) :: summary = ""
164 : : ! One-line description.
165 : :
166 : : character(len=160) :: args = ""
167 : : ! Description of the positional arguments.
168 : :
169 : : integer :: nopts = 0
170 : : ! Number of options.
171 : :
172 : : type(cmd_opt_t) :: opts(20)
173 : : ! opts(1:nopts) are the options of the command.
174 : :
175 : : integer :: nwrites = 0
176 : : ! Number of entries in writes.
177 : :
178 : : character(len=160) :: writes(4) = ""
179 : : ! writes(1:nwrites) describe the files written by the command.
180 : :
181 : : contains
182 : :
183 : : procedure :: add_opt => cmd_add_opt
184 : : ! Add an option.
185 : :
186 : : procedure :: add_write => cmd_add_write
187 : : ! Add the description of a file written by the command.
188 : :
189 : : procedure :: add_kpath_opts => cmd_add_kpath_opts
190 : : ! Add the options read by parse_kpath_args (--kpath, --ndivsm).
191 : :
192 : : procedure :: add_skw_params_opts => cmd_add_skw_params_opts
193 : : ! Add the options read by parse_skw_params (--lpratio, --rcut, --rsigma).
194 : :
195 : : procedure :: add_skw_interp_opts => cmd_add_skw_interp_opts
196 : : ! Add the options for the SKW interpolation on a new k-mesh (--skw-ngkpt, --skw-shiftk and the SKW parameters).
197 : :
198 : : procedure :: has_opt => cmd_has_opt
199 : : ! True if the command accepts the option.
200 : :
201 : : procedure :: show_help => cmd_show_help
202 : : ! Write the help of the command.
203 : :
204 : : procedure :: check_options => cmd_check_options
205 : : ! Check that the command line contains only accepted options.
206 : :
207 : : end type cmd_t
208 : : !!***
209 : :
210 : : contains
211 : :
212 : : !----------------------------------------------------------------------
213 : :
214 : : !!****f* m_argparse/args_parser
215 : : !! NAME
216 : : !! args_parser
217 : : !!
218 : : !! FUNCTION
219 : : !! Simple command line argument parser for abinit and other main programs.
220 : : !!
221 : : !! SOURCE
222 : :
223 : 1671 : type(args_t) function args_parser() result(args)
224 : :
225 : : !Local variables-------------------------------
226 : : integer :: ii, ierr, ntasks_per_node, ncpus
227 : : logical :: iam_master, verbose
228 : : real(dp) :: timelimit, memb_per_node, memb_per_cpu
229 : : character(len=500) :: arg !,msg
230 : :
231 : : ! *************************************************************************
232 : :
233 : 1671 : args%exit = 0; ierr=0; verbose = .False.
234 : 1671 : ntasks_per_node = -1; memb_per_node = -one; memb_per_cpu = -one
235 : :
236 : : ! Defaults for the memory limit from the Slurm environment (if any).
237 : : ! The command line options below take precedence.
238 : 1671 : call set_mem_from_slurm_env()
239 : :
240 : : #ifndef HAVE_FC_COMMAND_ARGUMENT
241 : : call wrtout(std_out,"get_command_argument is not supported by FC. Ignoring command lines options!")
242 : : return ! Nothing to do
243 : : #else
244 : :
245 [ + + ]: 1671 : if (command_argument_count() == 0) return
246 : :
247 : 1668 : iam_master = xmpi_comm_rank(xmpi_world) == 0
248 : :
249 : : ! Store full command line for future reference.
250 : 1668 : call get_command(args%cmdline)
251 : :
252 [ + + ]: 3351 : do ii=1,command_argument_count()
253 : 1683 : call get_command_argument(ii, arg)
254 : : !write(std_out,*)"arg", trim(arg)
255 : :
256 [ + + + + ]: 1683 : if (ii == 1 .and. .not. firstchar(arg, "-")) then
257 : : ! `abinit path` syntax reads input from path and deactivates files file mode.
258 : 1667 : args%input_path = trim(arg)
259 [ + + ]: 1667 : if (iam_master) then
260 [ - + ]: 1362 : ABI_CHECK(file_exists(args%input_path), sjoin("Cannot find input file:", args%input_path))
261 : : end if
262 : : cycle
263 : : end if
264 : :
265 [ + - - + ]: 1684 : if (arg == "-v" .or. arg == "--version") then
266 : 0 : call wrtout(std_out, trim(abinit_version))
267 : 0 : args%exit = args%exit + 1
268 : :
269 [ + + - + ]: 16 : else if (arg == "-b" .or. arg == "--build") then
270 : 1 : call print_kinds(unit=std_out)
271 : 1 : call xmpi_show_info(unit=std_out)
272 : 1 : call dump_cpp_options(std_out)
273 : 1 : call dump_config(std_out)
274 : 1 : call dump_optim(std_out)
275 : :
276 : 1 : args%exit = args%exit + 1
277 : :
278 [ + - + + ]: 15 : else if (arg == "-d" .or. arg == "--dry-run") then
279 : 1 : args%dry_run = 1
280 : :
281 [ - + ]: 14 : else if (arg == "--abimem-level") then
282 : 0 : call get_command_argument(ii + 1, arg)
283 : 0 : args%abimem_level = atoi(arg)
284 : :
285 [ - + ]: 14 : else if (arg == "--abimem-limit-mb") then
286 : 0 : call get_command_argument(ii + 1, arg)
287 : 0 : args%abimem_limit_mb = atof(arg)
288 : :
289 [ + - - + ]: 14 : else if (arg == "-j" .or. arg == "--omp-num-threads") then
290 : 0 : call get_command_argument(ii + 1, arg)
291 : 0 : call xomp_set_num_threads(atoi(arg))
292 : :
293 [ + - + + ]: 14 : else if (arg == "-t" .or. arg == "--timelimit") then
294 : : ! timelimit handler.
295 : 4 : call get_command_argument(ii + 1, arg)
296 : 4 : timelimit = str2sec(arg)
297 [ - + ]: 4 : if (timelimit < zero) then
298 : 0 : write(std_out,*)"Wrong timelimit argument: ",trim(arg)
299 : 0 : args%exit = args%exit + 1
300 : : else
301 : 4 : call exit_init(timelimit)
302 : : end if
303 : :
304 [ - + ]: 10 : else if (arg == "--ieee-halt") then
305 : : ! IEEE exceptions.
306 : 0 : call xieee_halt_ifexc(.True.)
307 : :
308 [ - + ]: 10 : else if (arg == "--ieee-signal") then
309 : 0 : call xieee_signal_ifexc(.True.)
310 : :
311 : 10 : else if (begins_with(arg, "--fft-ialltoall")) then
312 : : ! Enable/disable non-blocking ialltoall in MPI-FFT
313 : 0 : call fft_allow_ialltoall(parse_yesno(arg, "--fft-ialltoall"))
314 : :
315 : 10 : else if (begins_with(arg, "--ipi")) then
316 : 0 : call get_command_argument(ii + 1, arg)
317 : 0 : call ipi_setup(arg, xmpi_world)
318 : :
319 : 10 : else if (begins_with(arg, "--use-xgemm3m")) then
320 : : ! Enable/disable [Z,C]GEMM3
321 : 0 : call linalg_allow_gemm3m(parse_yesno(arg, "--use-xgemm3m"), write_msg=iam_master)
322 : :
323 : 10 : else if (begins_with(arg, "--use-mpi-in-place")) then
324 : : ! Enable/disable usage of MPI_IN_PLACE.
325 : 0 : call xmpi_set_inplace_operations(parse_yesno(arg, "--use-mpi-in-place"))
326 : :
327 : 10 : else if (begins_with(arg, "--plasma")) then
328 : : ! Enable/disable PLASMA
329 : 0 : call linalg_allow_plasma(parse_yesno(arg, "--plasma"))
330 : :
331 [ - + ]: 10 : else if (arg == "--gnu-mtrace") then
332 [ # # ]: 0 : if (iam_master) then
333 : 0 : call clib_mtrace(ierr)
334 [ # # ]: 0 : ABI_CHECK(ierr == 0, sjoin("clib_mtrace returned ierr:", itoa(ierr)))
335 : : end if
336 : :
337 [ - + ]: 10 : else if (arg == "--log") then
338 : : ! Enable logging
339 : 0 : call abi_log_status_state(new_do_write_log=.True., new_do_write_status=.True.)
340 : 0 : call libpaw_log_flag_set(.True.)
341 : :
342 [ - + ]: 10 : else if (arg == "--netcdf-classic") then
343 : : ! Use netcdf classic mode for new files when only sequential-IO needs to be performed
344 : 0 : call nctk_use_classic_for_seq()
345 : :
346 [ - + ]: 10 : else if (arg == "--enforce-fortran-io") then
347 : 0 : call enforce_fortran_io(.True.)
348 : :
349 : 10 : else if (begins_with(arg, "--mem-per-cpu=")) then
350 : 0 : memb_per_cpu = parse_slurm_mem(arg, "--mem-per-cpu=")
351 : 0 : call set_mem_per_cpu_mb(memb_per_cpu)
352 : :
353 : 10 : else if (begins_with(arg, "--mem=")) then
354 : 0 : memb_per_node = parse_slurm_mem(arg, "--mem=")
355 : :
356 : 10 : else if (begins_with(arg, "--ntasks-per-node=")) then
357 : 0 : ntasks_per_node = atoi(arg(len("--ntasks-per-node=") + 1:))
358 [ # # ]: 0 : ABI_CHECK(ntasks_per_node > 0, sjoin("Invalid value:", arg))
359 : :
360 : 10 : else if (begins_with(arg, "--cpus-per-task=")) then
361 : 0 : ncpus = atoi(arg(len("--cpus-per-task=") + 1:))
362 [ # # ]: 0 : ABI_CHECK(ncpus > 0, sjoin("Invalid value:", arg))
363 : 0 : call set_cpus_per_task(ncpus)
364 : :
365 [ + + ]: 10 : else if (arg == "--F03") then
366 : : ! For multibinit only
367 : 6 : args%multibinit_F03_mode = 1
368 : :
369 [ + - - + ]: 4 : else if (arg == "-h" .or. arg == "--help") then
370 [ # # ]: 0 : if (iam_master) then
371 : : ! Document the options.
372 : 0 : write(std_out,*)"-v, --version Show version number and exit."
373 : 0 : write(std_out,*)"-b, --build Show build parameters and exit."
374 : 0 : write(std_out,*)"-d, --dry-run Validate input file and exit."
375 : 0 : write(std_out,*)"-j, --omp-num-threads Set the number of OpenMp threads."
376 : 0 : write(std_out,*)"--use-xgemm3m[=yesno] Use ZGEMM3M routines instead of ZGEMM. Default: no "
377 : 0 : write(std_out,*)"--use-mpi-in-place[=yesno] Enable/disable usage of MPI_IN_PLACE in e.g. xmpi_sum. Default: no"
378 : 0 : write(std_out,*)" Note that some MPI libs e.g. intel-mpi may not implement this feature"
379 : 0 : write(std_out,*)" correctly so it is adviced to test this option with e.g. structural"
380 : 0 : write(std_out,*)" relaxations before running production calculations."
381 : 0 : write(std_out,*)"--ipi Activate socket-driven calculation using i-pi protocol."
382 : 0 : write(std_out,*)" For UNIX socket, use: --ipi {unixsocket}:UNIX"
383 : 0 : write(std_out,*)" For INET socket, use --ipi {host}:{port}. Usage example:"
384 : 0 : write(std_out,*)" `abinit run.abi --ipi {unixsocket}:UNIX > run.log`"
385 : 0 : write(std_out,*)" NB: Requires ionmov 28 and some tuning of input variables. See:"
386 : 0 : write(std_out,*)" https://wiki.fysik.dtu.dk/ase/dev/ase/calculators/socketio/socketio.html"
387 : 0 : write(std_out,*)"--log Enable log files and status files in parallel execution."
388 : 0 : write(std_out,*)"--netcdf-classic Use netcdf classic mode for new files if parallel-IO is not needed."
389 : 0 : write(std_out,*)" Default is netcdf4/hdf5"
390 : 0 : write(std_out,*)"--enforce-fortran-io Use Fortran-IO instead of MPI-IO when operating on Fortran files"
391 : 0 : write(std_out,*)" Useful to read files when the MPI-IO library is not efficient."
392 : 0 : write(std_out,*)" DON'T USE this option when the code needs to write large files e.g. WFK"
393 : 0 : write(std_out,*)"-t, --timelimit Set the timelimit for the run. Accepts time in Slurm syntax:"
394 : 0 : write(std_out,*)" days-hours"
395 : 0 : write(std_out,*)" days-hours:minutes"
396 : 0 : write(std_out,*)" days-hours:minutes:seconds"
397 : 0 : write(std_out,*)" minutes"
398 : 0 : write(std_out,*)" minutes:seconds"
399 : 0 : write(std_out,*)" hours:minutes:seconds"
400 : 0 : write(std_out,*)" At present only GS, relaxations and MD runs support this option"
401 : 0 : write(std_out,*)"--mem-per-cpu=<size>[units] Set memory per cpu using Slurm syntax. Default units are megabytes."
402 : 0 : write(std_out,*)" Different units can be specified using the suffix [K|M|G|T]."
403 : 0 : write(std_out,*)"--mem=<size>[units] Set memory per node using Slurm syntax. Default units are megabytes."
404 : 0 : write(std_out,*)" Requires `ntasks-per-node`. Not compatibile with `-mem-per-cpu`."
405 : 0 : write(std_out,*)"--ntasks-per-node=INT Set number of tasks per node. Used in conjunction with --mem`"
406 : 0 : write(std_out,*)"--cpus-per-task=INT Number of cpus (e.g. OpenMP threads) per MPI process."
407 : 0 : write(std_out,*)" The memory per MPI process is mem-per-cpu times cpus-per-task."
408 : 0 : write(std_out,*)" Without these options, the Slurm variables SLURM_MEM_PER_CPU,"
409 : 0 : write(std_out,*)" SLURM_MEM_PER_NODE, SLURM_NTASKS_PER_NODE and SLURM_CPUS_PER_TASK are used if set."
410 : 0 : write(std_out,*)"--verbose Enable verbose mode in argparse"
411 : 0 : write(std_out,*)"-h, --help Show this help and exit."
412 : :
413 : 0 : write(std_out,*)""
414 : 0 : write(std_out,*)""
415 : 0 : write(std_out,*)"=============================="
416 : 0 : write(std_out,*)"=== Options for developers ==="
417 : 0 : write(std_out,*)"=============================="
418 : 0 : write(std_out,*)"--abimem-level NUM Set memory profiling level. Requires HAVE_MEM_PROFILING in config.h"
419 : 0 : write(std_out,*)" 0 -> no file abimem.mocc is created, only memory allocation counters running."
420 : 0 : write(std_out,*)" 1 -> light version. Only memory peaks are written."
421 : 0 : write(std_out,*)" 2 -> file abimem.mocc is created with full information inside."
422 : 0 : write(std_out,*)" 3 -> Write info only if allocation/deallocation is larger or smaller than limit_mb"
423 : 0 : write(std_out,*)" depending on of the sign of abimem-limit-mb."
424 : 0 : write(std_out,*)" NOTE: By default, only master node writes, use negative values to make all MPI procs write info to disk."
425 : 0 : write(std_out,*)"--abimem-limit-mb NUM Log malloc/free only if size > limit in Megabytes. Requires abimem-level 3"
426 : 0 : write(std_out,*)"--fft-ialltoall[=yesno] Use non-blocking ialltoall in MPI-FFT (used only if ndat > 1 and MPI2+)."
427 : 0 : write(std_out,*)"--gnu-mtrace Enable mtrace (requires GNU and clib)."
428 : 0 : write(std_out,*)"--ieee-halt Halt the code if one of the *usual* IEEE exceptions is raised."
429 : 0 : write(std_out,*)"--ieee-signal Signal the occurrence of the *usual* IEEE exceptions."
430 : : ! Multibinit
431 : 0 : write(std_out,*)"--F03 Run F03 mode (Multibinit only)."
432 : : end if
433 : 0 : args%exit = args%exit + 1
434 : :
435 [ + - ]: 4 : else if (arg == "--verbose") then
436 : : verbose = .True.
437 : :
438 : : else
439 [ + - ]: 4 : if (firstchar(arg, "-")) then
440 [ # # ]: 0 : ABI_WARNING("Unsupported option: "//trim(arg))
441 : 0 : args%exit = args%exit + 1
442 : : else
443 : : continue
444 : : end if
445 : : end if
446 : : end do
447 : :
448 [ - + ]: 1668 : if (ntasks_per_node /= -1 .or. memb_per_node /= -one) then
449 : : ! Set mem_per_cpu from node info.
450 [ # # ]: 0 : ABI_CHECK(ntasks_per_node /= -1, "`mem-per-node` requires `ntasks-per-node`")
451 [ # # ]: 0 : ABI_CHECK(memb_per_node /= -one, "`ntasks-per-node` requires `mem-per-node`")
452 [ # # ]: 0 : ABI_CHECK(memb_per_cpu == -one, "`mem-per-cpu` and `mem-per-node` are mutually exclusive!")
453 : 0 : call set_mem_per_cpu_mb(memb_per_node / (ntasks_per_node * cpus_per_task))
454 : : end if
455 : :
456 [ - + ]: 1668 : if (verbose) then
457 : : call wrtout(std_out, sjoin(" mem_per_cpu_mb:", ftoa(mem_per_cpu_mb), "source:", mem_source, &
458 : 0 : "cpus_per_task:", itoa(cpus_per_task), "mem_per_rank_mb:", ftoa(mem_per_rank_mb())))
459 : : end if
460 : :
461 : : #endif
462 : :
463 : 3339 : end function args_parser
464 : : !!***
465 : :
466 : : !!****f* m_argparse/begins_with
467 : : !! NAME
468 : : !! begins_with
469 : : !!
470 : : !! FUNCTION
471 : : !! Returns true if argument arg begins with string
472 : : !!
473 : : !! SOURCE
474 : :
475 : 90 : pure logical function begins_with(arg, string) result(bool)
476 : :
477 : : !Arguments ------------------------------------
478 : : character(len=*),intent(in) :: arg,string
479 : : ! *************************************************************************
480 : :
481 [ - + - + : 20 : bool = .False.; if (len(arg) >= len(string)) bool = (arg(1:len(string)) == string)
- + - + -
+ - + - +
- + - + -
- ]
482 : :
483 : 0 : end function begins_with
484 : : !!***
485 : :
486 : : !----------------------------------------------------------------------
487 : :
488 : : !!****f* m_argparse/parse_yesno
489 : : !! NAME
490 : : !! parse_yesno
491 : : !!
492 : : !! FUNCTION
493 : : !! This function receives an argument, arg of the form --foo[=bool_value]
494 : : !! that begins with optname (i.e. --foo) and returns the value of bool_value
495 : : !! If bool_value is not present, returns default (.True. if not specified)
496 : : !!
497 : : !! SOURCE
498 : :
499 : 0 : logical function parse_yesno(arg, optname, default) result(bool)
500 : :
501 : : !Arguments ------------------------------------
502 : : character(len=*),intent(in) :: arg,optname
503 : : logical,optional,intent(in) :: default
504 : : ! *************************************************************************
505 : :
506 [ # # ]: 0 : bool = .True.; if (present(default)) bool = default
507 : :
508 : : ! Assume default if value is not given
509 [ # # ]: 0 : if (len_trim(optname) == len_trim(arg)) return
510 : :
511 : 0 : select case (arg(len(optname)+1:))
512 : : case ("=yes", "=y")
513 : 0 : bool = .True.
514 : : case ("=no", "=n")
515 : 0 : bool = .False.
516 : : case default
517 : 0 : write(std_out,*)"Wrong option ",trim(arg),". Will default to ",bool
518 [ # # # ]: 0 : ABI_ERROR("Aborting now")
519 : : end select
520 : :
521 : 0 : end function parse_yesno
522 : : !!***
523 : :
524 : : !----------------------------------------------------------------------
525 : :
526 : : !!****f* m_argparse/set_mem_from_slurm_env
527 : : !! NAME
528 : : !! set_mem_from_slurm_env
529 : : !!
530 : : !! FUNCTION
531 : : !! Set mem_per_cpu_mb and cpus_per_task from the Slurm environment variables, if they are defined:
532 : : !! SLURM_CPUS_PER_TASK, then SLURM_MEM_PER_CPU (Mb) or SLURM_MEM_PER_NODE (Mb) with SLURM_NTASKS_PER_NODE.
533 : : !! Only plain positive integers are accepted, other values are ignored with a warning.
534 : : !! Must be called before parsing the command line, whose options take precedence.
535 : : !!
536 : : !! SOURCE
537 : :
538 : 1671 : subroutine set_mem_from_slurm_env()
539 : :
540 : : !Local variables-------------------------------
541 : : integer :: ncpus, mem_cpu, mem_node, ntasks
542 : : ! *************************************************************************
543 : :
544 [ - + ]: 1671 : if (get_env_posint("SLURM_CPUS_PER_TASK", ncpus)) call set_cpus_per_task(ncpus)
545 : :
546 [ - + ]: 1671 : if (get_env_posint("SLURM_MEM_PER_CPU", mem_cpu)) then
547 : 0 : call set_mem_per_cpu_mb(one * mem_cpu, source="SLURM_MEM_PER_CPU")
548 [ - + ]: 1671 : else if (get_env_posint("SLURM_MEM_PER_NODE", mem_node)) then
549 [ # # ]: 0 : if (get_env_posint("SLURM_NTASKS_PER_NODE", ntasks)) then
550 : 0 : call set_mem_per_cpu_mb(one * mem_node / (ntasks * cpus_per_task), source="SLURM_MEM_PER_NODE")
551 : : end if
552 : : end if
553 : :
554 : : contains
555 : :
556 : 5013 : logical function get_env_posint(vname, ival) result(found)
557 : :
558 : : character(len=*),intent(in) :: vname
559 : : integer,intent(out) :: ival
560 : : integer :: vlen, istat
561 : : character(len=64) :: value
562 : :
563 : 5013 : found = .False.; ival = -1
564 : 5013 : call get_environment_variable(vname, value, length=vlen, status=istat)
565 [ - + - - ]: 5013 : if (istat /= 0 .or. vlen == 0) return
566 : :
567 : : ! Accept only plain positive integers (no units, lists or Slurm compact formats).
568 [ # # # # ]: 0 : if (vlen > len(value) .or. verify(trim(value), "0123456789") /= 0) then
569 [ # # ]: 0 : ABI_WARNING(sjoin("Ignoring environment variable", vname, "with value:", trim(value)))
570 : 0 : return
571 : : end if
572 : 0 : read(value, *, iostat=istat) ival
573 [ # # # # ]: 0 : if (istat /= 0 .or. ival <= 0) then
574 [ # # ]: 0 : ABI_WARNING(sjoin("Ignoring environment variable", vname, "with value:", trim(value)))
575 : 0 : ival = -1; return
576 : : end if
577 : 5013 : found = .True.
578 : :
579 : : end function get_env_posint
580 : :
581 : : end subroutine set_mem_from_slurm_env
582 : : !!***
583 : :
584 : : !!****f* m_argparse/parse_slurm_mem
585 : : !! NAME
586 : : !! parse_slurm_mem
587 : : !!
588 : : !! FUNCTION
589 : : !! Parse `arg` string with memory given in Slurm syntax. Return value in Mb.
590 : : !! From https://slurm.schedmd.com/sbatch.html
591 : : !!
592 : : !! --mem=<size>[units]
593 : : !!
594 : : !! Default units are megabytes. Different units can be specified using the suffix [K|M|G|T].
595 : : !!
596 : : !! For a list of slurm env variables that can be used to pass options to Abinit via the submission script, see:
597 : : !! https://docs.hpc.shef.ac.uk/en/latest/referenceinfo/scheduler/SLURM/SLURM-environment-variables.html
598 : : !!
599 : : !! SOURCE
600 : :
601 : 0 : real(dp) function parse_slurm_mem(arg, optname) result(mem_mb)
602 : :
603 : : !Arguments ------------------------------------
604 : : character(len=*),intent(in) :: arg,optname
605 : :
606 : : !Local variables-------------------------------
607 : : integer :: istop, istat
608 : : real(dp) :: fact
609 : : character(len=500) :: iomsg
610 : : ! *************************************************************************
611 : :
612 : : fact = one
613 : : istop = find_and_select(arg, &
614 : : ["K", "M", "G", "T"], &
615 [ # # ]: 0 : [one/1024._dp, one, 1024._dp, 1024._dp ** 2], fact, iomsg, default=one)
616 : :
617 [ # # ]: 0 : ABI_CHECK(istop /= -1, iomsg)
618 [ # # ]: 0 : istop = merge(len_trim(arg), istop - 1, istop == 0)
619 : :
620 : 0 : read(arg(len(optname) + 1: istop), *, iostat=istat, iomsg=iomsg) mem_mb
621 [ # # ]: 0 : ABI_CHECK(istat == 0, sjoin("Invalid syntax for memory string:", arg, ch10, "iomsg", iomsg))
622 [ # # ]: 0 : ABI_CHECK(mem_mb > zero, "mem_mb must be positive!")
623 : 0 : mem_mb = mem_mb * fact
624 : :
625 : 0 : end function parse_slurm_mem
626 : : !!***
627 : :
628 : : !----------------------------------------------------------------------
629 : :
630 : : !!****f* m_argparse/get_arg_int
631 : : !! NAME
632 : : !! get_arg_int
633 : : !!
634 : : !! FUNCTION
635 : : !! Parse scalar argument from command line. Return exit code.
636 : : !!
637 : : !! INPUT
638 : : !! argname= Argument name
639 : : !! [default]= Default value.
640 : : !! [exclude]= argname and exclude are mutually exclusive.
641 : : !!
642 : : !! OUTPUT
643 : : !! argval= Value of argname
644 : : !! msg= Error message
645 : : !!
646 : : !! SOURCE
647 : :
648 : 65 : integer function get_arg_int(argname, argval, msg, default, exclude) result(ierr)
649 : :
650 : : !Arguments ------------------------------------
651 : : !scalars
652 : : character(len=*),intent(in) :: argname
653 : : integer,intent(out) :: argval
654 : : character(len=*),intent(out) :: msg
655 : : integer,optional,intent(in) :: default
656 : : character(len=*),optional,intent(in) :: exclude
657 : :
658 : : !Local variables-------------------------------
659 : : integer :: ii, istat
660 : : logical :: found_argname, found_excl
661 : : character(len=500) :: arg, iomsg
662 : :
663 : : ! *************************************************************************
664 : :
665 [ + - ]: 65 : ierr = 0; msg = ""; if (present(default)) argval = default
666 : 65 : found_argname = .False.; found_excl = .False.
667 : :
668 [ + + ]: 83 : do ii=1,command_argument_count()
669 : 18 : call get_command_argument(ii, arg)
670 [ + - ]: 18 : if (present(exclude)) then
671 [ # # ]: 0 : if (arg == "--" // trim(exclude)) found_excl = .True.
672 : : end if
673 [ - + ]: 83 : if (arg == "--" // trim(argname)) then
674 : 0 : found_argname = .True.
675 : 0 : call get_command_argument(ii + 1, arg, status=istat)
676 [ # # ]: 0 : if (istat == 0) then
677 : 0 : read(arg, *, iostat=istat, iomsg=iomsg) argval
678 [ # # ]: 0 : if (istat /= 0) then
679 [ # # # # ]: 0 : ierr = ierr + 1; msg = sjoin(msg, ch10, iomsg)
680 : : end if
681 : : else
682 [ # # # # ]: 0 : ierr = ierr + 1; msg = sjoin(msg, ch10, "Error in get_command_argument")
683 : : end if
684 : : end if
685 : : end do
686 : :
687 [ - + - - : 65 : if (ierr /= 0) msg = sjoin("Error while reading argument: ", argname, ch10, msg)
- - ]
688 [ - + ]: 65 : if (found_argname .and. found_excl) then
689 [ # # # # ]: 0 : ierr = ierr + 1; msg = sjoin("Variables", argname, "and", exclude, "are mutually exclusive", ch10, msg)
690 : : end if
691 : :
692 [ + - ]: 65 : end function get_arg_int
693 : : !!***
694 : :
695 : : !!****f* m_argparse/get_arg_dp
696 : : !! NAME
697 : : !! get_arg_dp
698 : : !!
699 : : !! FUNCTION
700 : : !! Parse scalar argument from command line. Return exit code.
701 : : !!
702 : : !! INPUTS
703 : : !! argname= Argument name
704 : : !! [default]= Default value
705 : : !! [exclude]= argname and exclude are mutually exclusive.
706 : : !!
707 : : !! OUTPUT
708 : : !! argval= Value of argname
709 : : !! msg= Error message
710 : : !!
711 : : !! SOURCE
712 : :
713 : 44 : integer function get_arg_dp(argname, argval, msg, default, exclude) result(ierr)
714 : :
715 : : !Arguments ------------------------------------
716 : : !scalars
717 : : character(len=*),intent(in) :: argname
718 : : real(dp),intent(out) :: argval
719 : : character(len=*),intent(out) :: msg
720 : : real(dp),optional,intent(in) :: default
721 : : character(len=*),optional,intent(in) :: exclude
722 : :
723 : : !Local variables-------------------------------
724 : : integer :: ii, istat
725 : : logical :: found_argname, found_excl
726 : : character(len=500) :: arg, iomsg
727 : :
728 : : ! *************************************************************************
729 : :
730 [ + - ]: 44 : ierr = 0; msg = ""; if (present(default)) argval = default
731 : 44 : found_argname = .False.; found_excl = .False.
732 : :
733 [ - + ]: 44 : do ii=1,command_argument_count()
734 : 0 : call get_command_argument(ii, arg)
735 [ # # ]: 0 : if (present(exclude)) then
736 [ # # ]: 0 : if (arg == "--" // trim(exclude)) found_excl = .True.
737 : : end if
738 [ - - ]: 44 : if (arg == "--" // trim(argname)) then
739 : 0 : found_argname = .True.
740 : 0 : call get_command_argument(ii + 1, arg, status=istat)
741 [ # # ]: 0 : if (istat == 0) then
742 : 0 : istat = str2dp(arg, argval, iomsg)
743 [ # # ]: 0 : if (istat /= 0) then
744 [ # # # # ]: 0 : ierr = ierr + 1; msg = sjoin(msg, ch10, iomsg)
745 : : end if
746 : : else
747 [ # # # # ]: 0 : ierr = ierr + 1; msg = sjoin(msg, ch10, "Error in get_command_argument")
748 : : end if
749 : : end if
750 : : end do
751 : :
752 [ - + - - : 44 : if (ierr /= 0) msg = sjoin("Error while reading argument: ", argname, ch10, msg)
- - ]
753 [ - + ]: 44 : if (found_argname .and. found_excl) then
754 [ # # # # ]: 0 : ierr = ierr + 1; msg = sjoin("Variables", argname, "and", exclude, "are mutually exclusive", ch10, msg)
755 : : end if
756 : :
757 [ + - ]: 44 : end function get_arg_dp
758 : : !!***
759 : :
760 : : !----------------------------------------------------------------------
761 : :
762 : : !!****f* m_argparse/get_arg_str
763 : : !! NAME
764 : : !! get_arg_str
765 : : !!
766 : : !! FUNCTION
767 : : !! Parse scalar string argument from command line. Return exit code.
768 : : !!
769 : : !! INPUTS
770 : : !! argname= Argument name
771 : : !! [default]= Default value
772 : : !! [exclude]= argname and exclude are mutually exclusive.
773 : : !!
774 : : !! OUTPUT
775 : : !! argval= Value of argname
776 : : !! msg= Error message
777 : : !!
778 : : !! SOURCE
779 : :
780 : 0 : integer function get_arg_str(argname, argval, msg, default, exclude) result(ierr)
781 : :
782 : : !Arguments ------------------------------------
783 : : !scalars
784 : : character(len=*),intent(in) :: argname
785 : : character(len=*),intent(out) :: argval, msg
786 : : character(len=*),optional,intent(in) :: default
787 : : character(len=*),optional,intent(in) :: exclude
788 : :
789 : : !Local variables-------------------------------
790 : : integer :: ii, istat
791 : : logical :: found_argname, found_excl
792 : : character(len=500) :: arg
793 : :
794 : : ! *************************************************************************
795 : :
796 [ # # # # : 0 : ierr = 0; msg = ""; if (present(default)) argval = default
# # ]
797 : 0 : found_argname = .False.; found_excl = .False.
798 : :
799 [ # # ]: 0 : do ii=1,command_argument_count()
800 : 0 : call get_command_argument(ii, arg)
801 [ # # ]: 0 : if (present(exclude)) then
802 [ # # ]: 0 : if (arg == "--" // trim(exclude)) found_excl = .True.
803 : : end if
804 [ # # ]: 0 : if (arg == "--" // trim(argname)) then
805 : 0 : found_argname = .True.
806 : 0 : call get_command_argument(ii + 1, argval, status=istat)
807 [ # # ]: 0 : if (istat /= 0) then
808 [ # # # # ]: 0 : ierr = ierr + 1; msg = sjoin(msg, ch10, "Error in get_command_argument")
809 : : end if
810 : : end if
811 : : end do
812 : :
813 [ # # # # : 0 : if (ierr /= 0) msg = sjoin("Error while reading argument: ", argname, ch10, msg)
# # ]
814 [ # # ]: 0 : if (found_argname .and. found_excl) then
815 [ # # # # ]: 0 : ierr = ierr + 1; msg = sjoin("Variables", argname, "and", exclude, "are mutually exclusive", ch10, msg)
816 : : end if
817 : :
818 [ # # ]: 0 : end function get_arg_str
819 : : !!***
820 : :
821 : : !----------------------------------------------------------------------
822 : :
823 : : !!****f* m_argparse/get_arg_bool
824 : : !! NAME
825 : : !! get_arg_bool
826 : : !!
827 : : !! FUNCTION
828 : : !! Parse scalar boolean argument from command line. Return exit code.
829 : : !!
830 : : !! INPUTS
831 : : !! argname= Argument name
832 : : !! [default]= Default value
833 : : !! [exclude]= argname and exclude are mutually exclusive.
834 : : !!
835 : : !! OUTPUT
836 : : !! argval= Value of argname
837 : : !! msg= Error message
838 : : !!
839 : : !! SOURCE
840 : :
841 : 0 : integer function get_arg_bool(argname, argval, msg, default, exclude) result(ierr)
842 : :
843 : : !Arguments ------------------------------------
844 : : !scalars
845 : : character(len=*),intent(in) :: argname
846 : : logical,intent(out) :: argval
847 : : character(len=*),intent(out) :: msg
848 : : logical,optional,intent(in) :: default
849 : : character(len=*),optional,intent(in) :: exclude
850 : :
851 : : !Local variables-------------------------------
852 : : integer :: ii
853 : : logical :: found_argname, found_excl
854 : : character(len=500) :: arg
855 : :
856 : : ! *************************************************************************
857 : :
858 : 0 : ierr = 0; msg = ""; if (present(default)) argval = default
859 : 0 : found_argname = .False.; found_excl = .False.
860 : 0 : argval = .False.
861 : :
862 [ # # ]: 0 : do ii=1,command_argument_count()
863 : 0 : call get_command_argument(ii, arg)
864 [ # # ]: 0 : if (present(exclude)) then
865 [ # # ]: 0 : if (arg == "--" // trim(exclude)) found_excl = .True.
866 : : end if
867 [ # # ]: 0 : if (begins_with(arg, "--" // trim(argname))) then
868 : 0 : argval = parse_yesno(arg, "--" // trim(argname), default=.True.)
869 : 0 : found_argname = .True.
870 : : end if
871 : : end do
872 : :
873 : : if (ierr /= 0) msg = sjoin("Error while reading argument: ", argname, ch10, msg)
874 [ # # ]: 0 : if (found_argname .and. found_excl) then
875 [ # # # # ]: 0 : ierr = ierr + 1; msg = sjoin("Variables", argname, "and", exclude, "are mutually exclusive", ch10, msg)
876 : : end if
877 : :
878 [ # # ]: 0 : end function get_arg_bool
879 : : !!***
880 : :
881 : : !----------------------------------------------------------------------
882 : :
883 : : !!****f* m_argparse/get_start_step_num
884 : : !! NAME
885 : : !! get_start_step_num
886 : : !!
887 : : !! FUNCTION
888 : : !! Parse string from command line in the format "start:step:num" defining an arithmetic progression.
889 : : !! Return exit code.
890 : : !!
891 : : !! INPUTS
892 : : !! argname= Argument name
893 : : !! [default]= Default value
894 : : !! [exclude]= argname and exclude are mutually exclusive.
895 : : !!
896 : : !! OUTPUT
897 : : !! ilist= [start, step, num]
898 : : !! msg= Error message
899 : : !!
900 : : !! SOURCE
901 : :
902 : 0 : integer function get_start_step_num(argname, ilist, msg, default, exclude) result(ierr)
903 : :
904 : : !Arguments ------------------------------------
905 : : !scalars
906 : : character(len=*),intent(in) :: argname
907 : : integer,intent(out) :: ilist(3)
908 : : character(len=*),intent(out) :: msg
909 : : integer,optional,intent(in) :: default(3)
910 : : character(len=*),optional,intent(in) :: exclude
911 : :
912 : : !Local variables-------------------------------
913 : : integer :: ii, jj
914 : : character(len=500) :: str
915 : :
916 : : ! *************************************************************************
917 : :
918 : 0 : if (present(exclude)) then
919 : 0 : ierr = get_arg_str(argname, str, msg, default="", exclude=exclude)
920 : : else
921 : 0 : ierr = get_arg_str(argname, str, msg, default="")
922 : : end if
923 [ # # ]: 0 : if (ierr /= 0) return
924 : :
925 [ # # ]: 0 : if (len_trim(str) == 0) then
926 [ # # ]: 0 : if (present(default)) then
927 : 0 : ilist = default
928 : : else
929 [ # # # # ]: 0 : ierr = ierr + 1; msg = sjoin("Variables", argname, "is not found and default is not given")
930 : : end if
931 : 0 : return
932 : : end if
933 : :
934 : : ! We got a non-empty string. Let's parse it.
935 : 0 : ii = index(str, ":")
936 [ # # ]: 0 : if (ii <= 1) then
937 [ # # # # ]: 0 : msg = sjoin("Cannot find first `:` in string:", str)
938 : 0 : ierr = ierr + 1; return
939 : : end if
940 : 0 : ilist(1) = atoi(str(1:ii-1))
941 : :
942 : 0 : jj = index(str(ii+1:), ":")
943 [ # # ]: 0 : if (jj == 0) then
944 [ # # # # ]: 0 : msg = sjoin("Cannot find second `:` in string:", str)
945 : 0 : ierr = ierr + 1; return
946 : : end if
947 : :
948 : 0 : ilist(2) = atoi(str(ii+1: jj+ii-1))
949 : 0 : ilist(3) = atoi(str(jj+ii+1:))
950 : : !print *, "ilist:", ilist
951 : :
952 [ # # ]: 0 : end function get_start_step_num
953 : : !!***
954 : :
955 : : !!****f* m_argparse/get_arg_list_int
956 : : !! NAME
957 : : !! get_arg_list_int
958 : : !!
959 : : !! FUNCTION
960 : : !! Parse array argument from command line. Return exit code.
961 : : !!
962 : : !! INPUT
963 : : !! argname= Argument name
964 : : !! [default]= Default value (scalar)
965 : : !! [default_list]= Default value (vector)
966 : : !! [exclude]= argname and exclude are mutually exclusive.
967 : : !! [want_len]= Require want_len items in CLI.
968 : : !!
969 : : !! OUTPUT
970 : : !! argval= Value of argname
971 : : !! msg= Error message
972 : : !!
973 : : !! SOURCE
974 : :
975 [ # # # # : 0 : integer function get_arg_list_int(argname, argval, lenr, msg, default, default_list, exclude, want_len) result(ierr)
# # ]
976 : :
977 : : !Arguments ------------------------------------
978 : : !scalars
979 : : character(len=*),intent(in) :: argname
980 : : integer,intent(out) :: argval(:)
981 : : integer,intent(out) :: lenr
982 : : character(len=*),intent(out) :: msg
983 : : character(len=*),optional,intent(in) :: exclude
984 : : integer,optional,intent(in) :: default
985 : : integer,optional,intent(in) :: default_list(:)
986 : : integer,optional,intent(in) :: want_len
987 : :
988 : : !Local variables-------------------------------
989 : : integer :: ii, istat, iarg, maxlen
990 : : logical :: found_argname, found_excl
991 : : character(len=500) :: arg, iomsg
992 : :
993 : : ! *************************************************************************
994 : :
995 [ # # ]: 0 : ierr = 0; msg = ""; lenr = 0
996 : 0 : found_argname = .False.; found_excl = .False.
997 : :
998 : 0 : maxlen = size(argval);
999 [ # # ]: 0 : if (maxlen == 0) then
1000 [ # # # # ]: 0 : ierr = ierr + 1; msg = "zero-sized argval!"; return
1001 : : end if
1002 : :
1003 [ # # # # ]: 0 : if (present(default)) argval = default
1004 [ # # # # ]: 0 : if (present(default_list)) argval = default_list
1005 : :
1006 [ # # ]: 0 : do ii=1,command_argument_count()
1007 : 0 : call get_command_argument(ii, arg)
1008 [ # # ]: 0 : if (present(exclude)) then
1009 [ # # ]: 0 : if (arg == "--" // trim(exclude)) found_excl = .True.
1010 : : end if
1011 [ # # ]: 0 : if (arg == "--" // trim(argname)) then
1012 : : ! Read list of values
1013 : 0 : found_argname = .True.
1014 [ # # ]: 0 : do iarg=1,maxlen
1015 : 0 : call get_command_argument(ii + iarg, arg, status=istat)
1016 [ # # ]: 0 : if (istat == 0) then
1017 : : !write(std_out, *)"arg:", trim(arg)
1018 [ # # ]: 0 : if (startswith(arg, "--")) exit
1019 : 0 : read(arg,*, iostat=istat, iomsg=iomsg) argval(iarg)
1020 [ # # ]: 0 : if (istat == 0) then
1021 : 0 : lenr = lenr + 1
1022 : : else
1023 [ # # # # ]: 0 : ierr = ierr + 1; msg = sjoin(msg, ch10, iomsg)
1024 : : end if
1025 : : else
1026 : : ! If there are less than NUMBER arguments specified at the command line, VALUE will be filled with blanks.
1027 [ # # ]: 0 : if (arg == "") exit
1028 [ # # # # ]: 0 : ierr = ierr + 1; msg = sjoin(msg, ch10, "Error in get_command_argument")
1029 : : end if
1030 : : end do
1031 : : end if
1032 : : end do
1033 : :
1034 [ # # # # : 0 : if (ierr /= 0) msg = sjoin("Error while reading argument: ", argname, ch10, msg)
# # ]
1035 [ # # ]: 0 : if (found_argname .and. found_excl) then
1036 [ # # # # ]: 0 : ierr = ierr + 1; msg = sjoin("Variables", argname, "and", exclude, "are mutually exclusive", ch10, msg)
1037 : : end if
1038 : :
1039 [ # # ]: 0 : if (present(want_len)) then
1040 [ # # ]: 0 : if (found_argname) then
1041 [ # # ]: 0 : if (want_len /= lenr) then
1042 : 0 : ierr = ierr + 1
1043 [ # # # # ]: 0 : msg = sjoin(argname, "requires", itoa(want_len), " tokens while found ", itoa(lenr), ch10, msg)
1044 : : end if
1045 : : else
1046 : 0 : ierr = ierr + 1
1047 [ # # # # ]: 0 : msg = sjoin("Cannot find --", argname, "option in CLI and want_len:", itoa(want_len), ch10, msg)
1048 : : end if
1049 : : end if
1050 : :
1051 [ # # ]: 0 : end function get_arg_list_int
1052 : : !!***
1053 : :
1054 : : !----------------------------------------------------------------------
1055 : :
1056 : : !!****f* m_argparse/get_arg_list_dp
1057 : : !! NAME
1058 : : !! get_arg_list_dp
1059 : : !!
1060 : : !! FUNCTION
1061 : : !!
1062 : : !! INPUT
1063 : : !! argname
1064 : : !! [default]
1065 : : !! [default_list]
1066 : : !! [exclude]
1067 : : !! [want_len]
1068 : : !!
1069 : : !! OUTPUT
1070 : : !! argval
1071 : : !! msg
1072 : : !!
1073 : : !! SOURCE
1074 : :
1075 [ # # # # : 0 : integer function get_arg_list_dp(argname, argval, lenr, msg, default, default_list, exclude, want_len) result(ierr)
# # ]
1076 : :
1077 : : !Arguments ------------------------------------
1078 : : !scalars
1079 : : character(len=*),intent(in) :: argname
1080 : : real(dp),intent(out) :: argval(:)
1081 : : integer,intent(out) :: lenr
1082 : : character(len=*),intent(out) :: msg
1083 : : character(len=*),optional,intent(in) :: exclude
1084 : : real(dp),optional,intent(in) :: default
1085 : : real(dp),optional,intent(in) :: default_list(:)
1086 : : integer,optional,intent(in) :: want_len
1087 : :
1088 : : !Local variables-------------------------------
1089 : : integer :: ii, istat, iarg, maxlen
1090 : : logical :: found_argname, found_excl
1091 : : character(len=500) :: arg, iomsg
1092 : :
1093 : : ! *************************************************************************
1094 : :
1095 [ # # ]: 0 : ierr = 0; msg = ""; lenr = 0
1096 : 0 : found_argname = .False.; found_excl = .False.
1097 : :
1098 : 0 : maxlen = size(argval);
1099 [ # # ]: 0 : if (maxlen == 0) then
1100 [ # # # # ]: 0 : ierr = ierr + 1; msg = "zero-sized argval!"; return
1101 : : end if
1102 : :
1103 [ # # # # ]: 0 : if (present(default)) argval = default
1104 [ # # # # ]: 0 : if (present(default_list)) argval = default_list
1105 : :
1106 [ # # ]: 0 : do ii=1,command_argument_count()
1107 : 0 : call get_command_argument(ii, arg)
1108 [ # # ]: 0 : if (present(exclude)) then
1109 [ # # ]: 0 : if (arg == "--" // trim(exclude)) found_excl = .True.
1110 : : end if
1111 [ # # ]: 0 : if (arg == "--" // trim(argname)) then
1112 : : ! Read list of values
1113 : 0 : found_argname = .True.
1114 [ # # ]: 0 : do iarg=1,maxlen
1115 : 0 : call get_command_argument(ii + iarg, arg, status=istat)
1116 [ # # ]: 0 : if (istat == 0) then
1117 : : !write(std_out, *)"arg:", trim(arg)
1118 [ # # ]: 0 : if (startswith(arg, "--")) exit
1119 : 0 : istat = str2dp(arg, argval(iarg), iomsg)
1120 [ # # ]: 0 : if (istat == 0) then
1121 : 0 : lenr = lenr + 1
1122 : : else
1123 [ # # # # ]: 0 : ierr = ierr + 1; msg = sjoin(msg, ch10, iomsg)
1124 : : end if
1125 : : else
1126 : : ! If there are less than NUMBER arguments specified at the command line, VALUE will be filled with blanks.
1127 [ # # ]: 0 : if (arg == "") exit
1128 [ # # # # ]: 0 : ierr = ierr + 1; msg = sjoin(msg, ch10, "Error in get_command_argument")
1129 : : end if
1130 : : end do
1131 : : end if
1132 : : end do
1133 : :
1134 [ # # # # : 0 : if (ierr /= 0) msg = sjoin("Error while reading argument: ", argname, ch10, msg)
# # ]
1135 [ # # ]: 0 : if (found_argname .and. found_excl) then
1136 [ # # # # ]: 0 : ierr = ierr + 1; msg = sjoin("Variables", argname, "and", exclude, "are mutually exclusive", ch10, msg)
1137 : : end if
1138 : :
1139 [ # # ]: 0 : if (present(want_len)) then
1140 [ # # ]: 0 : if (found_argname) then
1141 [ # # ]: 0 : if (want_len /= lenr) then
1142 : 0 : ierr = ierr + 1
1143 [ # # # # ]: 0 : msg = sjoin(argname, "requires", itoa(want_len), " tokens while found ", itoa(lenr), ch10, msg)
1144 : : end if
1145 : : else
1146 : 0 : ierr = ierr + 1
1147 [ # # # # ]: 0 : msg = sjoin("Cannot find --", argname, " option in CLI and want_len:", itoa(want_len), ch10, msg)
1148 : : end if
1149 : : end if
1150 : :
1151 [ # # ]: 0 : end function get_arg_list_dp
1152 : : !!***
1153 : :
1154 : : !----------------------------------------------------------------------
1155 : :
1156 : : !!****f* ABINIT/parse_kargs
1157 : : !! NAME
1158 : : !! parse_kargs
1159 : : !!
1160 : : !! FUNCTION
1161 : : !! Parse command line arguments, return options related to k-point sampling
1162 : : !!
1163 : : !! INPUTS
1164 : : !!
1165 : : !! OUTPUT
1166 : : !!
1167 : : !! SOURCE
1168 : :
1169 : 0 : subroutine parse_kargs(kptopt, kptrlatt, nshiftk, shiftk, chksymbreak)
1170 : :
1171 : : !Arguments ------------------------------------
1172 : : integer,intent(out) :: kptopt, nshiftk, chksymbreak
1173 : : integer,intent(out) :: kptrlatt(3,3)
1174 : : real(dp),allocatable,intent(out) :: shiftk(:,:)
1175 : :
1176 : : !Local variables-------------------------------
1177 : : integer :: ii, lenr, ierr
1178 : : character(len=500) :: msg
1179 : : integer :: ivec9(9), ngkpt(3)
1180 : : real(dp) :: my_shiftk(3 * MAX_NSHIFTK)
1181 : :
1182 : : ! *************************************************************************
1183 : :
1184 [ # # ]: 0 : ABI_CHECK(get_arg("kptopt", kptopt, msg, default=1) == 0, msg)
1185 [ # # ]: 0 : ABI_CHECK(get_arg("chksymbreak", chksymbreak, msg, default=1) == 0, msg)
1186 : :
1187 : 0 : ierr = get_arg_list("ngkpt", ngkpt, lenr, msg, exclude="kptrlatt", want_len=3)
1188 [ # # ]: 0 : if (ierr == 0) then
1189 : : !if (lenr == 3) then
1190 : 0 : kptrlatt = 0
1191 [ # # ]: 0 : do ii=1,3
1192 : 0 : kptrlatt(ii, ii) = ngkpt(ii)
1193 : : end do
1194 : : else
1195 [ # # ]: 0 : ABI_CHECK(get_arg_list("kptrlatt", ivec9, lenr, msg, exclude="ngkpt", want_len=9) == 0, msg)
1196 [ # # ]: 0 : ABI_CHECK(lenr == 9, "Expecting 9 values for kptrlatt")
1197 [ # # # # ]: 0 : kptrlatt = transpose(reshape(ivec9, [3, 3]))
1198 : : end if
1199 : :
1200 : : ! Init default
1201 [ # # ]: 0 : ABI_CHECK(get_arg_list("shiftk", my_shiftk, lenr, msg) == 0, msg)
1202 [ # # ]: 0 : if (lenr /= 0) then
1203 [ # # ]: 0 : ABI_CHECK(mod(lenr, 3) == 0, "Expecting 3 * nshift array")
1204 : 0 : nshiftk = lenr / 3
1205 [ # # # # : 0 : ABI_MALLOC(shiftk, (3, nshiftk))
# # # # #
# # # #
# ]
1206 [ # # # # : 0 : shiftk = reshape(my_shiftk(1:lenr), [3, nshiftk])
# # # # ]
1207 : : else
1208 : 0 : nshiftk = 1
1209 [ # # # # : 0 : ABI_CALLOC(shiftk, (3, nshiftk))
# # # # ]
1210 : : !shiftk(:, 1) = [half, half, half]
1211 : : end if
1212 : : !write(std_out, *)"kptopt = ", kptopt, ", chksymbreak = ", chksymbreak, ", nshiftk = ", nshiftk, ", kptrlatt = ", kptrlatt
1213 : :
1214 : 0 : end subroutine parse_kargs
1215 : : !!***
1216 : :
1217 : : !----------------------------------------------------------------------
1218 : :
1219 : : !!****f* m_argparse/str2dp
1220 : : !! NAME
1221 : : !! str2dp
1222 : : !!
1223 : : !! FUNCTION
1224 : : !! Convert a string to a real number. Fractions such as 1/2 or -1/3 are accepted.
1225 : : !! Return nonzero status (and the error message in iomsg) if the string is not a number.
1226 : : !!
1227 : : !! SOURCE
1228 : :
1229 : 0 : integer function str2dp(str, val, iomsg) result(istat)
1230 : :
1231 : : !Arguments ------------------------------------
1232 : : character(len=*),intent(in) :: str
1233 : : real(dp),intent(out) :: val
1234 : : character(len=*),intent(inout) :: iomsg
1235 : :
1236 : : !Local variables-------------------------------
1237 : : integer :: islash
1238 : : real(dp) :: num, den
1239 : : ! *************************************************************************
1240 : :
1241 : 0 : val = zero
1242 : 0 : islash = index(str, "/")
1243 : 0 : if (islash == 0) then
1244 : 0 : read(str, *, iostat=istat, iomsg=iomsg) val
1245 : 0 : return
1246 : : end if
1247 : :
1248 : : ! Fraction. Note that a list-directed read would stop at the slash and return the numerator.
1249 : 0 : read(str(:islash-1), *, iostat=istat, iomsg=iomsg) num
1250 [ # # ]: 0 : if (istat /= 0) return
1251 : 0 : read(str(islash+1:), *, iostat=istat, iomsg=iomsg) den
1252 [ # # ]: 0 : if (istat /= 0) return
1253 [ # # ]: 0 : if (den == zero) then
1254 [ # # # # ]: 0 : istat = 1; iomsg = sjoin("Division by zero in:", str); return
1255 : : end if
1256 : 0 : val = num / den
1257 : :
1258 [ # # ]: 0 : end function str2dp
1259 : : !!***
1260 : :
1261 : : !----------------------------------------------------------------------
1262 : :
1263 : : !!****f* m_argparse/parse_kpath_args
1264 : : !! NAME
1265 : : !! parse_kpath_args
1266 : : !!
1267 : : !! FUNCTION
1268 : : !! Build a k-path from the command line options --kpath (or --argname) and --ndivsm.
1269 : : !! The vertices of the path are given in reduced coordinates as a list of 3*NPTS reals,
1270 : : !! e.g. `--kpath 0 0 0 1/2 0 1/2 1/2 1/4 3/4`. Use cmd%add_kpath_opts to document the options.
1271 : : !!
1272 : : !! INPUTS
1273 : : !! gprimd(3,3)=Reciprocal lattice vectors.
1274 : : !! [argname]=Name of the option with the vertices, without the leading --. Default: "kpath".
1275 : : !! [default_bounds(3,nbounds)]=Vertices used if the option is not given.
1276 : : !! If not present, the option is required.
1277 : : !!
1278 : : !! OUTPUT
1279 : : !! kpath<kpath_t>=The k-path. The caller is responsible for calling kpath%free.
1280 : : !!
1281 : : !! SOURCE
1282 : :
1283 [ # # # # : 0 : subroutine parse_kpath_args(gprimd, kpath, argname, default_bounds)
# # # # #
# # # ]
1284 : :
1285 : : !Arguments ------------------------------------
1286 : : real(dp),intent(in) :: gprimd(3,3)
1287 : : type(kpath_t),intent(out) :: kpath
1288 : : character(len=*),optional,intent(in) :: argname
1289 : : real(dp),optional,intent(in) :: default_bounds(:,:)
1290 : :
1291 : : !Local variables-------------------------------
1292 : : integer :: lenr, ndivsm, nbounds
1293 : : character(len=500) :: msg, name
1294 : : real(dp) :: vals(3 * MAX_KPATH_NPTS + 1)
1295 [ # # ]: 0 : real(dp),allocatable :: bounds(:,:)
1296 : : ! *************************************************************************
1297 : :
1298 [ # # # # ]: 0 : name = "kpath"; if (present(argname)) name = argname
1299 : :
1300 [ # # ]: 0 : ABI_CHECK(get_arg("ndivsm", ndivsm, msg, default=20) == 0, msg)
1301 [ # # ]: 0 : ABI_CHECK(ndivsm > 0, "--ndivsm must be positive")
1302 : :
1303 : : ! vals has one more element than allowed to detect a list that is too long.
1304 [ # # ]: 0 : ABI_CHECK(get_arg_list(trim(name), vals, lenr, msg) == 0, msg)
1305 [ # # ]: 0 : msg = sjoin("Too many vertices in --"//trim(name), ", max:", itoa(MAX_KPATH_NPTS))
1306 [ # # ]: 0 : ABI_CHECK(lenr <= 3 * MAX_KPATH_NPTS, msg)
1307 : :
1308 [ # # ]: 0 : if (lenr == 0) then
1309 [ # # ]: 0 : if (.not. present(default_bounds)) then
1310 [ # # ]: 0 : msg = sjoin("Option --"//trim(name), "is required: give the vertices of the path in reduced coordinates.")
1311 : 0 : ABI_ERROR(msg)
1312 : : end if
1313 : 0 : nbounds = size(default_bounds, dim=2)
1314 [ # # # # : 0 : ABI_MALLOC(bounds, (3, nbounds))
# # # # #
# # # #
# ]
1315 [ # # # # : 0 : bounds = default_bounds
# # # # #
# # # ]
1316 : : else
1317 [ # # ]: 0 : msg = sjoin("--"//trim(name), "expects 3*NPTS values but got:", itoa(lenr))
1318 [ # # ]: 0 : ABI_CHECK(mod(lenr, 3) == 0, msg)
1319 : 0 : nbounds = lenr / 3
1320 [ # # # # : 0 : ABI_MALLOC(bounds, (3, nbounds))
# # # # #
# # # #
# ]
1321 [ # # # # : 0 : bounds = reshape(vals(1:lenr), [3, nbounds])
# # # # ]
1322 : : end if
1323 : :
1324 [ # # ]: 0 : msg = sjoin("--"//trim(name), "requires at least 2 vertices but got:", itoa(nbounds))
1325 [ # # ]: 0 : ABI_CHECK(nbounds >= 2, msg)
1326 : :
1327 : 0 : call kpath%init(bounds, gprimd, ndivsm)
1328 [ # # ]: 0 : ABI_FREE(bounds)
1329 : :
1330 [ # # ]: 0 : end subroutine parse_kpath_args
1331 : : !!***
1332 : :
1333 : : !----------------------------------------------------------------------
1334 : :
1335 : : !!****f* m_argparse/cmd_add_kpath_opts
1336 : : !! NAME
1337 : : !! cmd_add_kpath_opts
1338 : : !!
1339 : : !! FUNCTION
1340 : : !! Add the options read by parse_kpath_args to the help of a command.
1341 : : !!
1342 : : !! INPUTS
1343 : : !! [argname]=Name of the option with the vertices, without the leading --. Default: "kpath".
1344 : : !! [default]=Default value of the vertices as shown in the help. Default: "" (required option).
1345 : : !!
1346 : : !! SOURCE
1347 : :
1348 : 0 : subroutine cmd_add_kpath_opts(self, argname, default)
1349 : :
1350 : : !Arguments ------------------------------------
1351 : : class(cmd_t),intent(inout) :: self
1352 : : character(len=*),optional,intent(in) :: argname, default
1353 : :
1354 : : !Local variables-------------------------------
1355 : : character(len=500) :: name, my_default
1356 : : ! *************************************************************************
1357 : :
1358 [ # # ]: 0 : name = "kpath"; if (present(argname)) name = argname
1359 [ # # # # ]: 0 : my_default = ""; if (present(default)) my_default = default
1360 : :
1361 : : call self%add_opt(trim(name), "3*NPTS*REAL", trim(my_default), &
1362 [ # # # # ]: 0 : "Vertices of the path in reduced coordinates, fractions allowed (e.g. 0 0 0 1/2 0 1/2)")
1363 : 0 : call self%add_opt("ndivsm", "INT", "20", "Number of divisions of the smallest segment of the path")
1364 : :
1365 [ # # ]: 0 : end subroutine cmd_add_kpath_opts
1366 : : !!***
1367 : :
1368 : : !----------------------------------------------------------------------
1369 : :
1370 : : !!****f* m_argparse/parse_skw_params
1371 : : !! NAME
1372 : : !! parse_skw_params
1373 : : !!
1374 : : !! FUNCTION
1375 : : !! Read the options of the star-function (SKW) interpolation: --lpratio, --rcut, --rsigma.
1376 : : !! Use cmd%add_skw_params_opts to document them.
1377 : : !!
1378 : : !! OUTPUT
1379 : : !! params(4)=SKW parameters in the format used by ebands_interp_kmesh and ebands_interp_kpath.
1380 : : !!
1381 : : !! SOURCE
1382 : :
1383 : 0 : subroutine parse_skw_params(params)
1384 : :
1385 : : !Arguments ------------------------------------
1386 : : real(dp),intent(out) :: params(4)
1387 : :
1388 : : !Local variables-------------------------------
1389 : : integer :: lpratio
1390 : : real(dp) :: rcut, rsigma
1391 : : character(len=500) :: msg
1392 : : ! *************************************************************************
1393 : :
1394 [ # # ]: 0 : ABI_CHECK(get_arg("lpratio", lpratio, msg, default=5) == 0, msg)
1395 [ # # ]: 0 : ABI_CHECK(get_arg("rcut", rcut, msg, default=zero) == 0, msg)
1396 [ # # ]: 0 : ABI_CHECK(get_arg("rsigma", rsigma, msg, default=zero) == 0, msg)
1397 [ # # ]: 0 : params = [one, dble(lpratio), rcut, rsigma]
1398 : :
1399 : 0 : end subroutine parse_skw_params
1400 : : !!***
1401 : :
1402 : : !----------------------------------------------------------------------
1403 : :
1404 : : !!****f* m_argparse/cmd_add_skw_params_opts
1405 : : !! NAME
1406 : : !! cmd_add_skw_params_opts
1407 : : !!
1408 : : !! FUNCTION
1409 : : !! Add the options read by parse_skw_params to the help of a command.
1410 : : !!
1411 : : !! SOURCE
1412 : :
1413 : 0 : subroutine cmd_add_skw_params_opts(self)
1414 : :
1415 : : !Arguments ------------------------------------
1416 : : class(cmd_t),intent(inout) :: self
1417 : : ! *************************************************************************
1418 : :
1419 : 0 : call self%add_opt("lpratio", "INT", "5", "SKW: ratio between star functions and ab-initio k-points")
1420 : 0 : call self%add_opt("rcut", "REAL", "0", "SKW: rcut parameter of the filter")
1421 : 0 : call self%add_opt("rsigma", "REAL", "0", "SKW: rsigma parameter of the filter")
1422 : :
1423 : 0 : end subroutine cmd_add_skw_params_opts
1424 : : !!***
1425 : :
1426 : : !----------------------------------------------------------------------
1427 : :
1428 : : !!****f* m_argparse/cmd_add_skw_interp_opts
1429 : : !! NAME
1430 : : !! cmd_add_skw_interp_opts
1431 : : !!
1432 : : !! FUNCTION
1433 : : !! Add the options for the SKW interpolation on a new k-mesh to the help of a command:
1434 : : !! --skw-ngkpt, --skw-shiftk and the options of parse_skw_params.
1435 : : !!
1436 : : !! SOURCE
1437 : :
1438 : 0 : subroutine cmd_add_skw_interp_opts(self)
1439 : :
1440 : : !Arguments ------------------------------------
1441 : : class(cmd_t),intent(inout) :: self
1442 : : ! *************************************************************************
1443 : :
1444 : 0 : call self%add_opt("skw-ngkpt", "N1 N2 N3", "", "Interpolate the energies with SKW on this k-mesh (in memory)")
1445 : 0 : call self%add_opt("skw-shiftk", "3*NSHIFTK*REAL", "0 0 0", "Shifts of the SKW k-mesh")
1446 : 0 : call self%add_skw_params_opts()
1447 : :
1448 : 0 : end subroutine cmd_add_skw_interp_opts
1449 : : !!***
1450 : :
1451 : : !----------------------------------------------------------------------
1452 : :
1453 : : !!****f* m_argparse/cmd_add_opt
1454 : : !! NAME
1455 : : !! cmd_add_opt
1456 : : !!
1457 : : !! FUNCTION
1458 : : !! Add an option to the command.
1459 : : !!
1460 : : !! INPUTS
1461 : : !! name: name without the leading --.
1462 : : !! metavar: placeholder for the value in the help (empty for a flag).
1463 : : !! default: default value as shown in the help (empty if none).
1464 : : !! help: one-line description.
1465 : : !!
1466 : : !! SOURCE
1467 : :
1468 : 0 : subroutine cmd_add_opt(self, name, metavar, default, help)
1469 : :
1470 : : !Arguments ------------------------------------
1471 : : class(cmd_t),intent(inout) :: self
1472 : : character(len=*),intent(in) :: name, metavar, default, help
1473 : : ! *************************************************************************
1474 : :
1475 : 0 : self%nopts = self%nopts + 1
1476 : 0 : ABI_CHECK(self%nopts <= size(self%opts), "Too many options: increase the size of cmd_t%opts")
1477 [ # # # # : 0 : self%opts(self%nopts) = cmd_opt_t(name, metavar, default, help)
# # # # ]
1478 : :
1479 [ # # ]: 0 : end subroutine cmd_add_opt
1480 : : !!***
1481 : :
1482 : : !----------------------------------------------------------------------
1483 : :
1484 : : !!****f* m_argparse/cmd_add_write
1485 : : !! NAME
1486 : : !! cmd_add_write
1487 : : !!
1488 : : !! FUNCTION
1489 : : !! Add the description of a file written by the command.
1490 : : !!
1491 : : !! SOURCE
1492 : :
1493 : 0 : subroutine cmd_add_write(self, what)
1494 : :
1495 : : !Arguments ------------------------------------
1496 : : class(cmd_t),intent(inout) :: self
1497 : : character(len=*),intent(in) :: what
1498 : : ! *************************************************************************
1499 : :
1500 : 0 : self%nwrites = self%nwrites + 1
1501 : 0 : ABI_CHECK(self%nwrites <= size(self%writes), "Too many files: increase the size of cmd_t%writes")
1502 [ # # ]: 0 : self%writes(self%nwrites) = what
1503 : :
1504 [ # # ]: 0 : end subroutine cmd_add_write
1505 : : !!***
1506 : :
1507 : : !----------------------------------------------------------------------
1508 : :
1509 : : !!****f* m_argparse/cmd_has_opt
1510 : : !! NAME
1511 : : !! cmd_has_opt
1512 : : !!
1513 : : !! FUNCTION
1514 : : !! True if the command accepts the option `name` (without the leading --).
1515 : : !!
1516 : : !! SOURCE
1517 : :
1518 : 0 : logical function cmd_has_opt(self, name) result(ans)
1519 : :
1520 : : !Arguments ------------------------------------
1521 : : class(cmd_t),intent(in) :: self
1522 : : character(len=*),intent(in) :: name
1523 : : ! *************************************************************************
1524 : :
1525 : 0 : ans = .False.
1526 [ # # # # : 0 : if (self%nopts > 0) ans = any(name == self%opts(1:self%nopts)%name)
# # ]
1527 : :
1528 : 0 : end function cmd_has_opt
1529 : : !!***
1530 : :
1531 : : !----------------------------------------------------------------------
1532 : :
1533 : : !!****f* m_argparse/cmd_show_help
1534 : : !! NAME
1535 : : !! cmd_show_help
1536 : : !!
1537 : : !! FUNCTION
1538 : : !! Write the help of the command: usage, summary, arguments, options and files written.
1539 : : !!
1540 : : !! INPUTS
1541 : : !! unit: Fortran unit.
1542 : : !! prog: name of the program, used in the usage line.
1543 : : !! [global_help]: one-line description of the options accepted by all the commands of prog.
1544 : : !!
1545 : : !! SOURCE
1546 : :
1547 : 0 : subroutine cmd_show_help(self, unit, prog, global_help)
1548 : :
1549 : : !Arguments ------------------------------------
1550 : : class(cmd_t),intent(in) :: self
1551 : : integer,intent(in) :: unit
1552 : : character(len=*),intent(in) :: prog
1553 : : character(len=*),optional,intent(in) :: global_help
1554 : :
1555 : : !Local variables-------------------------------
1556 : : integer :: io, iw, width
1557 : : character(len=100) :: lhs
1558 : : character(len=200) :: rhs
1559 : : ! *************************************************************************
1560 : :
1561 : 0 : write(unit,"(4a)")"Usage: ", trim(prog), " ", trim(self%usage)
1562 : 0 : write(unit,"(2a)")ch10, trim(self%summary)
1563 [ # # ]: 0 : if (len_trim(self%args) > 0) write(unit,"(2a)")ch10, trim(self%args)
1564 : :
1565 [ # # ]: 0 : if (self%nopts > 0) then
1566 : 0 : write(unit,"(2a)")ch10,"Options:"
1567 : : ! Width of the first column: the longest "--name METAVAR" of the command, at least 26.
1568 : 0 : width = 26
1569 [ # # ]: 0 : do io=1,self%nopts
1570 : 0 : width = max(width, len_trim(self%opts(io)%name) + len_trim(self%opts(io)%metavar) + 3)
1571 : : end do
1572 [ # # ]: 0 : do io=1,self%nopts
1573 : 0 : lhs = "--"//trim(self%opts(io)%name)
1574 [ # # # # ]: 0 : if (len_trim(self%opts(io)%metavar) > 0) lhs = trim(lhs)//" "//trim(self%opts(io)%metavar)
1575 : 0 : rhs = self%opts(io)%help
1576 [ # # # # : 0 : if (len_trim(self%opts(io)%default) > 0) rhs = trim(rhs)//" (default: "//trim(self%opts(io)%default)//")"
# # ]
1577 : 0 : write(unit,"(2x,a,1x,a)") lhs(1:width), trim(rhs)
1578 : : end do
1579 : : end if
1580 : :
1581 [ # # ]: 0 : if (present(global_help)) then
1582 : 0 : write(unit,"(2a)")ch10,"Global options:"
1583 : 0 : write(unit,"(2x,a)") trim(global_help)
1584 : : end if
1585 : :
1586 [ # # ]: 0 : if (self%nwrites > 0) then
1587 : 0 : write(unit,"(2a)")ch10,"Files written:"
1588 [ # # ]: 0 : do iw=1,self%nwrites
1589 [ # # ]: 0 : write(unit,"(2x,a)") trim(self%writes(iw))
1590 : : end do
1591 : : end if
1592 : :
1593 : 0 : end subroutine cmd_show_help
1594 : : !!***
1595 : :
1596 : : !----------------------------------------------------------------------
1597 : :
1598 : : !!****f* m_argparse/cmd_check_options
1599 : : !! NAME
1600 : : !! cmd_check_options
1601 : : !!
1602 : : !! FUNCTION
1603 : : !! Check that the options on the command line are accepted by the command or are global options.
1604 : : !! `--name` and `--name=value` are checked; -h and -v are accepted; a dash followed by a digit or
1605 : : !! a dot is a negative value, not an option. The values of the options are not checked.
1606 : : !!
1607 : : !! INPUTS
1608 : : !! [global_opts(:)]: names (without the leading --) of the options accepted by all the commands.
1609 : : !! [istart]: first argument to check. Default: 2 (the argument after the command).
1610 : : !!
1611 : : !! OUTPUT
1612 : : !! ierr: 0 if all the options are accepted.
1613 : : !! msg: error message with the valid options of the command if ierr /= 0.
1614 : : !!
1615 : : !! SOURCE
1616 : :
1617 [ # # # # ]: 0 : subroutine cmd_check_options(self, ierr, msg, global_opts, istart)
1618 : :
1619 : : !Arguments ------------------------------------
1620 : : class(cmd_t),intent(in) :: self
1621 : : integer,intent(out) :: ierr
1622 : : character(len=*),intent(out) :: msg
1623 : : character(len=*),optional,intent(in) :: global_opts(:)
1624 : : integer,optional,intent(in) :: istart
1625 : :
1626 : : !Local variables-------------------------------
1627 : : integer :: iarg, ieq, io, my_istart
1628 : : character(len=500) :: arg, key
1629 : : ! *************************************************************************
1630 : :
1631 [ # # ]: 0 : ierr = 0; msg = ""
1632 [ # # ]: 0 : my_istart = 2; if (present(istart)) my_istart = istart
1633 : :
1634 [ # # ]: 0 : do iarg=my_istart,command_argument_count()
1635 : 0 : call get_command_argument(iarg, arg)
1636 [ # # # # ]: 0 : if (len_trim(arg) < 2 .or. arg(1:1) /= "-") cycle
1637 : :
1638 [ # # ]: 0 : if (arg(1:2) == "--") then
1639 : 0 : key = arg(3:); ieq = index(key, "=")
1640 [ # # # # ]: 0 : if (ieq > 0) key = key(:ieq-1)
1641 [ # # ]: 0 : if (self%has_opt(key)) cycle
1642 [ # # ]: 0 : if (present(global_opts)) then
1643 [ # # # # : 0 : if (any(key == global_opts)) cycle
# # ]
1644 : : end if
1645 : : else
1646 [ # # # # ]: 0 : if (arg == "-h" .or. arg == "-v") cycle
1647 [ # # ]: 0 : if (index("0123456789.", arg(2:2)) > 0) cycle
1648 : : end if
1649 : :
1650 : 0 : ierr = 1
1651 [ # # # # ]: 0 : msg = sjoin("unknown option", trim(arg), "for command", trim(self%name)//".")
1652 [ # # # # ]: 0 : msg = trim(msg)//ch10//"Options of "//trim(self%name)//":"
1653 [ # # ]: 0 : do io=1,self%nopts
1654 [ # # # # ]: 0 : msg = trim(msg)//" --"//trim(self%opts(io)%name)
1655 : : end do
1656 [ # # # # : 0 : if (self%nopts == 0) msg = trim(msg)//" none (only the global options)"
# # ]
1657 : 0 : return
1658 : : end do
1659 : :
1660 [ # # ]: 0 : end subroutine cmd_check_options
1661 : : !!***
1662 : :
1663 : 0 : end module m_argparse
1664 : : !!***
|
