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, 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 :
45 : implicit none
46 :
47 : private
48 :
49 : public :: get_arg ! Parse scalar argument from command line. Return exit code.
50 :
51 : interface get_arg
52 : module procedure get_arg_int
53 : module procedure get_arg_dp
54 : module procedure get_arg_str
55 : module procedure get_arg_bool
56 : end interface get_arg
57 :
58 : public :: get_arg_list ! Parse array argument from command line. Return exit code.
59 :
60 : interface get_arg_list
61 : module procedure get_arg_list_int
62 : module procedure get_arg_list_dp
63 : end interface get_arg_list
64 :
65 : public :: get_start_step_num ! Parse string from command line in the format "start:step:num"
66 : ! defining an arithmetic progression.
67 : public :: parse_kargs ! Parse command line arguments, return options related to k-point sampling
68 : !!***
69 :
70 : !!****t* m_argparse/args_t
71 : !! NAME
72 : !! args_t
73 : !!
74 : !! FUNCTION
75 : !! Stores command line options
76 : !!
77 : !! SOURCE
78 :
79 : type,public :: args_t
80 :
81 : integer :: exit = 0
82 : ! /=0 to exit after having parsed the command line options.
83 :
84 : integer :: abimem_level = 0
85 : ! Options for memory profiling. See m_profiling_abi
86 :
87 : integer :: dry_run = 0
88 : ! /= 0 to exit after the validation of the input file.
89 :
90 : real(dp) :: abimem_limit_mb = 20.0_dp
91 : ! Optional memory limit in Mb. used when abimem_level == 3
92 :
93 : character(len=500) :: cmdline = ""
94 : ! The entire command line
95 :
96 : character(len=fnlen) :: input_path = ""
97 :
98 : !! Below are for multibinit
99 : integer :: multibinit_F03_mode = 0
100 : !1: legacy mode
101 : !0: use full F03 implementation mode
102 : ! TODO: It will be deprecated when everything is ready in and the new mode will be default.
103 :
104 : end type args_t
105 :
106 : public :: args_parser ! Parse command line options.
107 : !!***
108 :
109 : contains
110 :
111 : !----------------------------------------------------------------------
112 :
113 : !!****f* m_argparse/args_parser
114 : !! NAME
115 : !! args_parser
116 : !!
117 : !! FUNCTION
118 : !! Simple command line argument parser for abinit and other main programs.
119 : !!
120 : !! SOURCE
121 :
122 1655 : type(args_t) function args_parser() result(args)
123 :
124 : !Local variables-------------------------------
125 : integer :: ii, ierr, ntasks_per_node = -1
126 : logical :: iam_master, verbose
127 : real(dp) :: timelimit, memb_per_node = -one, memb_per_cpu = -one
128 : character(len=500) :: arg !,msg
129 :
130 : ! *************************************************************************
131 :
132 1655 : args%exit = 0; ierr=0; verbose = .False.
133 :
134 : #ifndef HAVE_FC_COMMAND_ARGUMENT
135 : call wrtout(std_out,"get_command_argument is not supported by FC. Ignoring command lines options!")
136 : return ! Nothing to do
137 : #else
138 :
139 1655 : if (command_argument_count() == 0) return
140 :
141 1652 : iam_master = xmpi_comm_rank(xmpi_world) == 0
142 :
143 : ! Store full command line for future reference.
144 1652 : call get_command(args%cmdline)
145 :
146 3319 : do ii=1,command_argument_count()
147 1667 : call get_command_argument(ii, arg)
148 : !write(std_out,*)"arg", trim(arg)
149 :
150 1667 : if (ii == 1 .and. .not. firstchar(arg, "-")) then
151 : ! `abinit path` syntax reads input from path and deactivates files file mode.
152 1651 : args%input_path = trim(arg)
153 1651 : if (iam_master) then
154 1349 : ABI_CHECK(file_exists(args%input_path), sjoin("Cannot find input file:", args%input_path))
155 : end if
156 : cycle
157 : end if
158 :
159 1668 : if (arg == "-v" .or. arg == "--version") then
160 0 : call wrtout(std_out, trim(abinit_version))
161 0 : args%exit = args%exit + 1
162 :
163 16 : else if (arg == "-b" .or. arg == "--build") then
164 1 : call print_kinds(unit=std_out)
165 1 : call xmpi_show_info(unit=std_out)
166 1 : call dump_cpp_options(std_out)
167 1 : call dump_config(std_out)
168 1 : call dump_optim(std_out)
169 :
170 1 : args%exit = args%exit + 1
171 :
172 15 : else if (arg == "-d" .or. arg == "--dry-run") then
173 1 : args%dry_run = 1
174 :
175 14 : else if (arg == "--abimem-level") then
176 0 : call get_command_argument(ii + 1, arg)
177 0 : args%abimem_level = atoi(arg)
178 :
179 14 : else if (arg == "--abimem-limit-mb") then
180 0 : call get_command_argument(ii + 1, arg)
181 0 : args%abimem_limit_mb = atof(arg)
182 :
183 14 : else if (arg == "-j" .or. arg == "--omp-num-threads") then
184 0 : call get_command_argument(ii + 1, arg)
185 0 : call xomp_set_num_threads(atoi(arg))
186 :
187 14 : else if (arg == "-t" .or. arg == "--timelimit") then
188 : ! timelimit handler.
189 4 : call get_command_argument(ii + 1, arg)
190 4 : timelimit = str2sec(arg)
191 4 : if (timelimit < zero) then
192 0 : write(std_out,*)"Wrong timelimit argument: ",trim(arg)
193 0 : args%exit = args%exit + 1
194 : else
195 4 : call exit_init(timelimit)
196 : end if
197 :
198 10 : else if (arg == "--ieee-halt") then
199 : ! IEEE exceptions.
200 0 : call xieee_halt_ifexc(.True.)
201 :
202 10 : else if (arg == "--ieee-signal") then
203 0 : call xieee_signal_ifexc(.True.)
204 :
205 10 : else if (begins_with(arg, "--fft-ialltoall")) then
206 : ! Enable/disable non-blocking ialltoall in MPI-FFT
207 0 : call fft_allow_ialltoall(parse_yesno(arg, "--fft-ialltoall"))
208 :
209 10 : else if (begins_with(arg, "--ipi")) then
210 0 : call get_command_argument(ii + 1, arg)
211 0 : call ipi_setup(arg, xmpi_world)
212 :
213 10 : else if (begins_with(arg, "--use-xgemm3m")) then
214 : ! Enable/disable [Z,C]GEMM3
215 0 : call linalg_allow_gemm3m(parse_yesno(arg, "--use-xgemm3m"), write_msg=iam_master)
216 :
217 10 : else if (begins_with(arg, "--use-mpi-in-place")) then
218 : ! Enable/disable usage of MPI_IN_PLACE.
219 0 : call xmpi_set_inplace_operations(parse_yesno(arg, "--use-mpi-in-place"))
220 :
221 10 : else if (begins_with(arg, "--plasma")) then
222 : ! Enable/disable PLASMA
223 0 : call linalg_allow_plasma(parse_yesno(arg, "--plasma"))
224 :
225 10 : else if (arg == "--gnu-mtrace") then
226 0 : if (iam_master) then
227 0 : call clib_mtrace(ierr)
228 0 : ABI_CHECK(ierr == 0, sjoin("clib_mtrace returned ierr:", itoa(ierr)))
229 : end if
230 :
231 10 : else if (arg == "--log") then
232 : ! Enable logging
233 0 : call abi_log_status_state(new_do_write_log=.True., new_do_write_status=.True.)
234 0 : call libpaw_log_flag_set(.True.)
235 :
236 10 : else if (arg == "--netcdf-classic") then
237 : ! Use netcdf classic mode for new files when only sequential-IO needs to be performed
238 0 : call nctk_use_classic_for_seq()
239 :
240 10 : else if (arg == "--enforce-fortran-io") then
241 0 : call enforce_fortran_io(.True.)
242 :
243 10 : else if (begins_with(arg, "--mem-per-cpu=")) then
244 0 : memb_per_cpu = parse_slurm_mem(arg, "--mem-per-cpu=")
245 0 : call set_mem_per_cpu_mb(memb_per_cpu)
246 :
247 10 : else if (begins_with(arg, "--mem=")) then
248 0 : memb_per_node = parse_slurm_mem(arg, "--mem=")
249 :
250 10 : else if (begins_with(arg, "--ntasks-per-node=")) then
251 0 : call get_command_argument(ii + 1, arg)
252 0 : ntasks_per_node = atoi(arg)
253 :
254 10 : else if (arg == "--F03") then
255 : ! For multibinit only
256 6 : args%multibinit_F03_mode = 1
257 :
258 4 : else if (arg == "-h" .or. arg == "--help") then
259 0 : if (iam_master) then
260 : ! Document the options.
261 0 : write(std_out,*)"-v, --version Show version number and exit."
262 0 : write(std_out,*)"-b, --build Show build parameters and exit."
263 0 : write(std_out,*)"-d, --dry-run Validate input file and exit."
264 0 : write(std_out,*)"-j, --omp-num-threads Set the number of OpenMp threads."
265 0 : write(std_out,*)"--use-xgemm3m[=yesno] Use ZGEMM3M routines instead of ZGEMM. Default: no "
266 0 : write(std_out,*)"--use-mpi-in-place[=yesno] Enable/disable usage of MPI_IN_PLACE in e.g. xmpi_sum. Default: no"
267 0 : write(std_out,*)" Note that some MPI libs e.g. intel-mpi may not implement this feature"
268 0 : write(std_out,*)" correctly so it is adviced to test this option with e.g. structural"
269 0 : write(std_out,*)" relaxations before running production calculations."
270 0 : write(std_out,*)"--ipi Activate socket-driven calculation using i-pi protocol."
271 0 : write(std_out,*)" For UNIX socket, use: --ipi {unixsocket}:UNIX"
272 0 : write(std_out,*)" For INET socket, use --ipi {host}:{port}. Usage example:"
273 0 : write(std_out,*)" `abinit run.abi --ipi {unixsocket}:UNIX > run.log`"
274 0 : write(std_out,*)" NB: Requires ionmov 28 and some tuning of input variables. See:"
275 0 : write(std_out,*)" https://wiki.fysik.dtu.dk/ase/dev/ase/calculators/socketio/socketio.html"
276 0 : write(std_out,*)"--log Enable log files and status files in parallel execution."
277 0 : write(std_out,*)"--netcdf-classic Use netcdf classic mode for new files if parallel-IO is not needed."
278 0 : write(std_out,*)" Default is netcdf4/hdf5"
279 0 : write(std_out,*)"--enforce-fortran-io Use Fortran-IO instead of MPI-IO when operating on Fortran files"
280 0 : write(std_out,*)" Useful to read files when the MPI-IO library is not efficient."
281 0 : write(std_out,*)" DON'T USE this option when the code needs to write large files e.g. WFK"
282 0 : write(std_out,*)"-t, --timelimit Set the timelimit for the run. Accepts time in Slurm syntax:"
283 0 : write(std_out,*)" days-hours"
284 0 : write(std_out,*)" days-hours:minutes"
285 0 : write(std_out,*)" days-hours:minutes:seconds"
286 0 : write(std_out,*)" minutes"
287 0 : write(std_out,*)" minutes:seconds"
288 0 : write(std_out,*)" hours:minutes:seconds"
289 0 : write(std_out,*)" At present only GS, relaxations and MD runs support this option"
290 0 : write(std_out,*)"--mem-per-cpu=<size>[units] Set memory per cpu using Slurm syntax. Default units are megabytes."
291 0 : write(std_out,*)" Different units can be specified using the suffix [K|M|G|T]."
292 0 : write(std_out,*)"--mem=<size>[units] Set memory per node using Slurm syntax. Default units are megabytes."
293 0 : write(std_out,*)" Requires `ntasks-per-node`. Not compatibile with `-mem-per-cpu`."
294 0 : write(std_out,*)"--ntasks-per-node=INT Set number of tasks per node. Used in conjunction with --mem`"
295 0 : write(std_out,*)"--verbose Enable verbose mode in argparse"
296 0 : write(std_out,*)"-h, --help Show this help and exit."
297 :
298 0 : write(std_out,*)""
299 0 : write(std_out,*)""
300 0 : write(std_out,*)"=============================="
301 0 : write(std_out,*)"=== Options for developers ==="
302 0 : write(std_out,*)"=============================="
303 0 : write(std_out,*)"--abimem-level NUM Set memory profiling level. Requires HAVE_MEM_PROFILING in config.h"
304 0 : write(std_out,*)" 0 -> no file abimem.mocc is created, only memory allocation counters running."
305 0 : write(std_out,*)" 1 -> light version. Only memory peaks are written."
306 0 : write(std_out,*)" 2 -> file abimem.mocc is created with full information inside."
307 0 : write(std_out,*)" 3 -> Write info only if allocation/deallocation is larger or smaller than limit_mb"
308 0 : write(std_out,*)" depending on of the sign of abimem-limit-mb."
309 0 : write(std_out,*)" NOTE: By default, only master node writes, use negative values to make all MPI procs write info to disk."
310 0 : write(std_out,*)"--abimem-limit-mb NUM Log malloc/free only if size > limit in Megabytes. Requires abimem-level 3"
311 0 : write(std_out,*)"--fft-ialltoall[=yesno] Use non-blocking ialltoall in MPI-FFT (used only if ndat > 1 and MPI2+)."
312 0 : write(std_out,*)"--gnu-mtrace Enable mtrace (requires GNU and clib)."
313 0 : write(std_out,*)"--ieee-halt Halt the code if one of the *usual* IEEE exceptions is raised."
314 0 : write(std_out,*)"--ieee-signal Signal the occurrence of the *usual* IEEE exceptions."
315 : ! Multibinit
316 0 : write(std_out,*)"--F03 Run F03 mode (Multibinit only)."
317 : end if
318 0 : args%exit = args%exit + 1
319 :
320 4 : else if (arg == "--verbose") then
321 1667 : verbose = .True.
322 :
323 : else
324 4 : if (firstchar(arg, "-")) then
325 0 : ABI_WARNING("Unsupported option: "//trim(arg))
326 0 : args%exit = args%exit + 1
327 : else
328 : continue
329 : end if
330 : end if
331 : end do
332 :
333 1652 : if (ntasks_per_node /= -1 .or. memb_per_node /= -one) then
334 : ! Set mem_per_cpu from node info.
335 0 : ABI_CHECK(ntasks_per_node /= -1, "`mem-per-node` requires `ntasks-per-node`")
336 0 : ABI_CHECK(memb_per_node /= -one, "`ntasks-per-node` requires `mem-per-node`")
337 0 : ABI_CHECK(memb_per_cpu == -one, "`mem-per-cpu` and `mem-per-node` are mutually exclusive!")
338 0 : call set_mem_per_cpu_mb(memb_per_node / ntasks_per_node)
339 : end if
340 :
341 : #endif
342 :
343 3307 : end function args_parser
344 : !!***
345 :
346 : !!****f* m_argparse/begins_with
347 : !! NAME
348 : !! begins_with
349 : !!
350 : !! FUNCTION
351 : !! Returns true if argument arg begins with string
352 : !!
353 : !! SOURCE
354 :
355 80 : pure logical function begins_with(arg, string) result(bool)
356 :
357 : !Arguments ------------------------------------
358 : character(len=*),intent(in) :: arg,string
359 : ! *************************************************************************
360 :
361 20 : bool = .False.; if (len(arg) >= len(string)) bool = (arg(1:len(string)) == string)
362 :
363 0 : end function begins_with
364 : !!***
365 :
366 : !----------------------------------------------------------------------
367 :
368 : !!****f* m_argparse/parse_yesno
369 : !! NAME
370 : !! parse_yesno
371 : !!
372 : !! FUNCTION
373 : !! This function receives an argument, arg of the form --foo[=bool_value]
374 : !! that begins with optname (i.e. --foo) and returns the value of bool_value
375 : !! If bool_value is not present, returns default (.True. if not specified)
376 : !!
377 : !! SOURCE
378 :
379 0 : logical function parse_yesno(arg, optname, default) result(bool)
380 :
381 : !Arguments ------------------------------------
382 : character(len=*),intent(in) :: arg,optname
383 : logical,optional,intent(in) :: default
384 : ! *************************************************************************
385 :
386 0 : bool = .True.; if (present(default)) bool = default
387 :
388 : ! Assume default if value is not given
389 0 : if (len_trim(optname) == len_trim(arg)) return
390 :
391 0 : select case (arg(len(optname)+1:))
392 : case ("=yes", "=y")
393 0 : bool = .True.
394 : case ("=no", "=n")
395 0 : bool = .False.
396 : case default
397 0 : write(std_out,*)"Wrong option ",trim(arg),". Will default to ",bool
398 0 : ABI_ERROR("Aborting now")
399 : end select
400 :
401 0 : end function parse_yesno
402 : !!***
403 :
404 : !----------------------------------------------------------------------
405 :
406 : !!****f* m_argparse/parse_slurm_mem
407 : !! NAME
408 : !! parse_slurm_mem
409 : !!
410 : !! FUNCTION
411 : !! Parse `arg` string with memory given in Slurm syntax. Return value in Mb.
412 : !! From https://slurm.schedmd.com/sbatch.html
413 : !!
414 : !! --mem=<size>[units]
415 : !!
416 : !! Default units are megabytes. Different units can be specified using the suffix [K|M|G|T].
417 : !!
418 : !! For a list of slurm env variables that can be used to pass options to Abinit via the submission script, see:
419 : !! https://docs.hpc.shef.ac.uk/en/latest/referenceinfo/scheduler/SLURM/SLURM-environment-variables.html
420 : !!
421 : !! SOURCE
422 :
423 0 : real(dp) function parse_slurm_mem(arg, optname) result(mem_mb)
424 :
425 : !Arguments ------------------------------------
426 : character(len=*),intent(in) :: arg,optname
427 :
428 : !Local variables-------------------------------
429 : integer :: istop, istat
430 : real(dp) :: fact
431 : character(len=500) :: iomsg
432 : ! *************************************************************************
433 :
434 : fact = one
435 : istop = find_and_select(arg, &
436 : ["K", "M", "G", "T"], &
437 0 : [one/1024._dp, one, 1024._dp, 1024._dp ** 2], fact, iomsg, default=one)
438 :
439 0 : ABI_CHECK(istop /= -1, iomsg)
440 0 : istop = merge(len_trim(arg), istop - 1, istop == 0)
441 :
442 0 : read(arg(len(optname) + 1: istop), *, iostat=istat, iomsg=iomsg) mem_mb
443 0 : ABI_CHECK(istat == 0, sjoin("Invalid syntax for memory string:", arg, ch10, "iomsg", iomsg))
444 0 : ABI_CHECK(mem_mb > zero, "mem_mb must be positive!")
445 0 : mem_mb = mem_mb * fact
446 :
447 0 : end function parse_slurm_mem
448 : !!***
449 :
450 : !----------------------------------------------------------------------
451 :
452 : !!****f* m_argparse/get_arg_int
453 : !! NAME
454 : !! get_arg_int
455 : !!
456 : !! FUNCTION
457 : !! Parse scalar argument from command line. Return exit code.
458 : !!
459 : !! INPUT
460 : !! argname= Argument name
461 : !! [default]= Default value.
462 : !! [exclude]= argname and exclude are mutually exclusive.
463 : !!
464 : !! OUTPUT
465 : !! argval= Value of argname
466 : !! msg= Error message
467 : !!
468 : !! SOURCE
469 :
470 65 : integer function get_arg_int(argname, argval, msg, default, exclude) result(ierr)
471 :
472 : !Arguments ------------------------------------
473 : !scalars
474 : character(len=*),intent(in) :: argname
475 : integer,intent(out) :: argval
476 : character(len=*),intent(out) :: msg
477 : integer,optional,intent(in) :: default
478 : character(len=*),optional,intent(in) :: exclude
479 :
480 : !Local variables-------------------------------
481 : integer :: ii, istat
482 : logical :: found_argname, found_excl
483 : character(len=500) :: arg, iomsg
484 :
485 : ! *************************************************************************
486 :
487 65 : ierr = 0; msg = ""; if (present(default)) argval = default
488 65 : found_argname = .False.; found_excl = .False.
489 :
490 83 : do ii=1,command_argument_count()
491 18 : call get_command_argument(ii, arg)
492 18 : if (present(exclude)) then
493 0 : if (arg == "--" // trim(exclude)) found_excl = .True.
494 : end if
495 83 : if (arg == "--" // trim(argname)) then
496 0 : found_argname = .True.
497 0 : call get_command_argument(ii + 1, arg, status=istat)
498 0 : if (istat == 0) then
499 0 : read(arg, *, iostat=istat, iomsg=iomsg) argval
500 0 : if (istat /= 0) then
501 0 : ierr = ierr + 1; msg = sjoin(msg, ch10, iomsg)
502 : end if
503 : else
504 0 : ierr = ierr + 1; msg = sjoin(msg, ch10, "Error in get_command_argument")
505 : end if
506 : end if
507 : end do
508 :
509 65 : if (ierr /= 0) msg = sjoin("Error while reading argument: ", argname, ch10, msg)
510 65 : if (found_argname .and. found_excl) then
511 0 : ierr = ierr + 1; msg = sjoin("Variables", argname, "and", exclude, "are mutually exclusive", ch10, msg)
512 : end if
513 :
514 65 : end function get_arg_int
515 : !!***
516 :
517 : !!****f* m_argparse/get_arg_dp
518 : !! NAME
519 : !! get_arg_dp
520 : !!
521 : !! FUNCTION
522 : !! Parse scalar argument from command line. Return exit code.
523 : !!
524 : !! INPUTS
525 : !! argname= Argument name
526 : !! [default]= Default value
527 : !! [exclude]= argname and exclude are mutually exclusive.
528 : !!
529 : !! OUTPUT
530 : !! argval= Value of argname
531 : !! msg= Error message
532 : !!
533 : !! SOURCE
534 :
535 44 : integer function get_arg_dp(argname, argval, msg, default, exclude) result(ierr)
536 :
537 : !Arguments ------------------------------------
538 : !scalars
539 : character(len=*),intent(in) :: argname
540 : real(dp),intent(out) :: argval
541 : character(len=*),intent(out) :: msg
542 : real(dp),optional,intent(in) :: default
543 : character(len=*),optional,intent(in) :: exclude
544 :
545 : !Local variables-------------------------------
546 : integer :: ii, istat
547 : logical :: found_argname, found_excl
548 : character(len=500) :: arg, iomsg
549 :
550 : ! *************************************************************************
551 :
552 44 : ierr = 0; msg = ""; if (present(default)) argval = default
553 44 : found_argname = .False.; found_excl = .False.
554 :
555 44 : do ii=1,command_argument_count()
556 0 : call get_command_argument(ii, arg)
557 0 : if (present(exclude)) then
558 0 : if (arg == "--" // trim(exclude)) found_excl = .True.
559 : end if
560 44 : if (arg == "--" // trim(argname)) then
561 0 : found_argname = .True.
562 0 : call get_command_argument(ii + 1, arg, status=istat)
563 0 : if (istat == 0) then
564 0 : read(arg, *, iostat=istat, iomsg=iomsg) argval
565 0 : if (istat /= 0) then
566 0 : ierr = ierr + 1; msg = sjoin(msg, ch10, iomsg)
567 : end if
568 : else
569 0 : ierr = ierr + 1; msg = sjoin(msg, ch10, "Error in get_command_argument")
570 : end if
571 : end if
572 : end do
573 :
574 44 : if (ierr /= 0) msg = sjoin("Error while reading argument: ", argname, ch10, msg)
575 44 : if (found_argname .and. found_excl) then
576 0 : ierr = ierr + 1; msg = sjoin("Variables", argname, "and", exclude, "are mutually exclusive", ch10, msg)
577 : end if
578 :
579 44 : end function get_arg_dp
580 : !!***
581 :
582 : !----------------------------------------------------------------------
583 :
584 : !!****f* m_argparse/get_arg_str
585 : !! NAME
586 : !! get_arg_str
587 : !!
588 : !! FUNCTION
589 : !! Parse scalar string argument from command line. Return exit code.
590 : !!
591 : !! INPUTS
592 : !! argname= Argument name
593 : !! [default]= Default value
594 : !! [exclude]= argname and exclude are mutually exclusive.
595 : !!
596 : !! OUTPUT
597 : !! argval= Value of argname
598 : !! msg= Error message
599 : !!
600 : !! SOURCE
601 :
602 0 : integer function get_arg_str(argname, argval, msg, default, exclude) result(ierr)
603 :
604 : !Arguments ------------------------------------
605 : !scalars
606 : character(len=*),intent(in) :: argname
607 : character(len=*),intent(out) :: argval, msg
608 : character(len=*),optional,intent(in) :: default
609 : character(len=*),optional,intent(in) :: exclude
610 :
611 : !Local variables-------------------------------
612 : integer :: ii, istat
613 : logical :: found_argname, found_excl
614 : character(len=500) :: arg
615 :
616 : ! *************************************************************************
617 :
618 0 : ierr = 0; msg = ""; if (present(default)) argval = default
619 0 : found_argname = .False.; found_excl = .False.
620 :
621 0 : do ii=1,command_argument_count()
622 0 : call get_command_argument(ii, arg)
623 0 : if (present(exclude)) then
624 0 : if (arg == "--" // trim(exclude)) found_excl = .True.
625 : end if
626 0 : if (arg == "--" // trim(argname)) then
627 0 : found_argname = .True.
628 0 : call get_command_argument(ii + 1, argval, status=istat)
629 0 : if (istat /= 0) then
630 0 : ierr = ierr + 1; msg = sjoin(msg, ch10, "Error in get_command_argument")
631 : end if
632 : end if
633 : end do
634 :
635 0 : if (ierr /= 0) msg = sjoin("Error while reading argument: ", argname, ch10, msg)
636 0 : if (found_argname .and. found_excl) then
637 0 : ierr = ierr + 1; msg = sjoin("Variables", argname, "and", exclude, "are mutually exclusive", ch10, msg)
638 : end if
639 :
640 0 : end function get_arg_str
641 : !!***
642 :
643 : !----------------------------------------------------------------------
644 :
645 : !!****f* m_argparse/get_arg_bool
646 : !! NAME
647 : !! get_arg_bool
648 : !!
649 : !! FUNCTION
650 : !! Parse scalar boolean argument from command line. Return exit code.
651 : !!
652 : !! INPUTS
653 : !! argname= Argument name
654 : !! [default]= Default value
655 : !! [exclude]= argname and exclude are mutually exclusive.
656 : !!
657 : !! OUTPUT
658 : !! argval= Value of argname
659 : !! msg= Error message
660 : !!
661 : !! SOURCE
662 :
663 0 : integer function get_arg_bool(argname, argval, msg, default, exclude) result(ierr)
664 :
665 : !Arguments ------------------------------------
666 : !scalars
667 : character(len=*),intent(in) :: argname
668 : logical,intent(out) :: argval
669 : character(len=*),intent(out) :: msg
670 : logical,optional,intent(in) :: default
671 : character(len=*),optional,intent(in) :: exclude
672 :
673 : !Local variables-------------------------------
674 : integer :: ii
675 : logical :: found_argname, found_excl
676 : character(len=500) :: arg
677 :
678 : ! *************************************************************************
679 :
680 0 : ierr = 0; msg = ""; if (present(default)) argval = default
681 0 : found_argname = .False.; found_excl = .False.
682 0 : argval = .False.
683 :
684 0 : do ii=1,command_argument_count()
685 0 : call get_command_argument(ii, arg)
686 0 : if (present(exclude)) then
687 0 : if (arg == "--" // trim(exclude)) found_excl = .True.
688 : end if
689 0 : if (begins_with(arg, "--" // trim(argname))) then
690 0 : argval = parse_yesno(arg, "--" // trim(argname), default=.True.)
691 0 : found_argname = .True.
692 : end if
693 : end do
694 :
695 : if (ierr /= 0) msg = sjoin("Error while reading argument: ", argname, ch10, msg)
696 0 : if (found_argname .and. found_excl) then
697 0 : ierr = ierr + 1; msg = sjoin("Variables", argname, "and", exclude, "are mutually exclusive", ch10, msg)
698 : end if
699 :
700 0 : end function get_arg_bool
701 : !!***
702 :
703 : !----------------------------------------------------------------------
704 :
705 : !!****f* m_argparse/get_start_step_num
706 : !! NAME
707 : !! get_start_step_num
708 : !!
709 : !! FUNCTION
710 : !! Parse string from command line in the format "start:step:num" defining an arithmetic progression.
711 : !! Return exit code.
712 : !!
713 : !! INPUTS
714 : !! argname= Argument name
715 : !! [default]= Default value
716 : !! [exclude]= argname and exclude are mutually exclusive.
717 : !!
718 : !! OUTPUT
719 : !! ilist= [start, step, num]
720 : !! msg= Error message
721 : !!
722 : !! SOURCE
723 :
724 0 : integer function get_start_step_num(argname, ilist, msg, default, exclude) result(ierr)
725 :
726 : !Arguments ------------------------------------
727 : !scalars
728 : character(len=*),intent(in) :: argname
729 : integer,intent(out) :: ilist(3)
730 : character(len=*),intent(out) :: msg
731 : integer,optional,intent(in) :: default(3)
732 : character(len=*),optional,intent(in) :: exclude
733 :
734 : !Local variables-------------------------------
735 : integer :: ii, jj
736 : character(len=500) :: str
737 :
738 : ! *************************************************************************
739 :
740 0 : if (present(exclude)) then
741 0 : ierr = get_arg_str(argname, str, msg, default="", exclude=exclude)
742 : else
743 0 : ierr = get_arg_str(argname, str, msg, default="")
744 : end if
745 0 : if (ierr /= 0) return
746 :
747 0 : if (len_trim(str) == 0) then
748 0 : if (present(default)) then
749 0 : ilist = default
750 : else
751 0 : ierr = ierr + 1; msg = sjoin("Variables", argname, "is not found and default is not given")
752 : end if
753 0 : return
754 : end if
755 :
756 : ! We got a non-empty string. Let's parse it.
757 0 : ii = index(str, ":")
758 0 : if (ii <= 1) then
759 0 : msg = sjoin("Cannot find first `:` in string:", str)
760 0 : ierr = ierr + 1; return
761 : end if
762 0 : ilist(1) = atoi(str(1:ii-1))
763 :
764 0 : jj = index(str(ii+1:), ":")
765 0 : if (jj == 0) then
766 0 : msg = sjoin("Cannot find second `:` in string:", str)
767 0 : ierr = ierr + 1; return
768 : end if
769 :
770 0 : ilist(2) = atoi(str(ii+1: jj+ii-1))
771 0 : ilist(3) = atoi(str(jj+ii+1:))
772 : !print *, "ilist:", ilist
773 :
774 0 : end function get_start_step_num
775 : !!***
776 :
777 : !!****f* m_argparse/get_arg_list_int
778 : !! NAME
779 : !! get_arg_list_int
780 : !!
781 : !! FUNCTION
782 : !! Parse array argument from command line. Return exit code.
783 : !!
784 : !! INPUT
785 : !! argname= Argument name
786 : !! [default]= Default value (scalar)
787 : !! [default_list]= Default value (vector)
788 : !! [exclude]= argname and exclude are mutually exclusive.
789 : !! [want_len]= Require want_len items in CLI.
790 : !!
791 : !! OUTPUT
792 : !! argval= Value of argname
793 : !! msg= Error message
794 : !!
795 : !! SOURCE
796 :
797 0 : integer function get_arg_list_int(argname, argval, lenr, msg, default, default_list, exclude, want_len) result(ierr)
798 :
799 : !Arguments ------------------------------------
800 : !scalars
801 : character(len=*),intent(in) :: argname
802 : integer,intent(out) :: argval(:)
803 : integer,intent(out) :: lenr
804 : character(len=*),intent(out) :: msg
805 : character(len=*),optional,intent(in) :: exclude
806 : integer,optional,intent(in) :: default
807 : integer,optional,intent(in) :: default_list(:)
808 : integer,optional,intent(in) :: want_len
809 :
810 : !Local variables-------------------------------
811 : integer :: ii, istat, iarg, maxlen
812 : logical :: found_argname, found_excl
813 : character(len=500) :: arg, iomsg
814 :
815 : ! *************************************************************************
816 :
817 0 : ierr = 0; msg = ""; lenr = 0
818 0 : found_argname = .False.; found_excl = .False.
819 :
820 0 : maxlen = size(argval);
821 0 : if (maxlen == 0) then
822 0 : ierr = ierr + 1; msg = "zero-sized argval!"; return
823 : end if
824 :
825 0 : if (present(default)) argval = default
826 0 : if (present(default_list)) argval = default_list
827 :
828 0 : do ii=1,command_argument_count()
829 0 : call get_command_argument(ii, arg)
830 0 : if (present(exclude)) then
831 0 : if (arg == "--" // trim(exclude)) found_excl = .True.
832 : end if
833 0 : if (arg == "--" // trim(argname)) then
834 : ! Read list of values
835 0 : found_argname = .True.
836 0 : do iarg=1,maxlen
837 0 : call get_command_argument(ii + iarg, arg, status=istat)
838 0 : if (istat == 0) then
839 : !write(std_out, *)"arg:", trim(arg)
840 0 : if (startswith(arg, "--")) exit
841 0 : read(arg,*, iostat=istat, iomsg=iomsg) argval(iarg)
842 0 : if (istat == 0) then
843 0 : lenr = lenr + 1
844 : else
845 0 : ierr = ierr + 1; msg = sjoin(msg, ch10, iomsg)
846 : end if
847 : else
848 : ! If there are less than NUMBER arguments specified at the command line, VALUE will be filled with blanks.
849 0 : if (arg == "") exit
850 0 : ierr = ierr + 1; msg = sjoin(msg, ch10, "Error in get_command_argument")
851 : end if
852 : end do
853 : end if
854 : end do
855 :
856 0 : if (ierr /= 0) msg = sjoin("Error while reading argument: ", argname, ch10, msg)
857 0 : if (found_argname .and. found_excl) then
858 0 : ierr = ierr + 1; msg = sjoin("Variables", argname, "and", exclude, "are mutually exclusive", ch10, msg)
859 : end if
860 :
861 0 : if (present(want_len)) then
862 0 : if (found_argname) then
863 0 : if (want_len /= lenr) then
864 0 : ierr = ierr + 1
865 0 : msg = sjoin(argname, "requires", itoa(want_len), " tokens while found ", itoa(lenr), ch10, msg)
866 : end if
867 : else
868 0 : ierr = ierr + 1
869 0 : msg = sjoin("Cannot find --", argname, "option in CLI and want_len:", itoa(want_len), ch10, msg)
870 : end if
871 : end if
872 :
873 0 : end function get_arg_list_int
874 : !!***
875 :
876 : !----------------------------------------------------------------------
877 :
878 : !!****f* m_argparse/get_arg_list_dp
879 : !! NAME
880 : !! get_arg_list_dp
881 : !!
882 : !! FUNCTION
883 : !!
884 : !! INPUT
885 : !! argname
886 : !! [default]
887 : !! [default_list]
888 : !! [exclude]
889 : !! [want_len]
890 : !!
891 : !! OUTPUT
892 : !! argval
893 : !! msg
894 : !!
895 : !! SOURCE
896 :
897 0 : integer function get_arg_list_dp(argname, argval, lenr, msg, default, default_list, exclude, want_len) result(ierr)
898 :
899 : !Arguments ------------------------------------
900 : !scalars
901 : character(len=*),intent(in) :: argname
902 : real(dp),intent(out) :: argval(:)
903 : integer,intent(out) :: lenr
904 : character(len=*),intent(out) :: msg
905 : character(len=*),optional,intent(in) :: exclude
906 : real(dp),optional,intent(in) :: default
907 : real(dp),optional,intent(in) :: default_list(:)
908 : integer,optional,intent(in) :: want_len
909 :
910 : !Local variables-------------------------------
911 : integer :: ii, istat, iarg, maxlen
912 : logical :: found_argname, found_excl
913 : character(len=500) :: arg, iomsg
914 :
915 : ! *************************************************************************
916 :
917 0 : ierr = 0; msg = ""; lenr = 0
918 0 : found_argname = .False.; found_excl = .False.
919 :
920 0 : maxlen = size(argval);
921 0 : if (maxlen == 0) then
922 0 : ierr = ierr + 1; msg = "zero-sized argval!"; return
923 : end if
924 :
925 0 : if (present(default)) argval = default
926 0 : if (present(default_list)) argval = default_list
927 :
928 0 : do ii=1,command_argument_count()
929 0 : call get_command_argument(ii, arg)
930 0 : if (present(exclude)) then
931 0 : if (arg == "--" // trim(exclude)) found_excl = .True.
932 : end if
933 0 : if (arg == "--" // trim(argname)) then
934 : ! Read list of values
935 0 : found_argname = .True.
936 0 : do iarg=1,maxlen
937 0 : call get_command_argument(ii + iarg, arg, status=istat)
938 0 : if (istat == 0) then
939 : !write(std_out, *)"arg:", trim(arg)
940 0 : if (startswith(arg, "--")) exit
941 0 : read(arg,*, iostat=istat, iomsg=iomsg) argval(iarg)
942 0 : if (istat == 0) then
943 0 : lenr = lenr + 1
944 : else
945 0 : ierr = ierr + 1; msg = sjoin(msg, ch10, iomsg)
946 : end if
947 : else
948 : ! If there are less than NUMBER arguments specified at the command line, VALUE will be filled with blanks.
949 0 : if (arg == "") exit
950 0 : ierr = ierr + 1; msg = sjoin(msg, ch10, "Error in get_command_argument")
951 : end if
952 : end do
953 : end if
954 : end do
955 :
956 0 : if (ierr /= 0) msg = sjoin("Error while reading argument: ", argname, ch10, msg)
957 0 : if (found_argname .and. found_excl) then
958 0 : ierr = ierr + 1; msg = sjoin("Variables", argname, "and", exclude, "are mutually exclusive", ch10, msg)
959 : end if
960 :
961 0 : if (present(want_len)) then
962 0 : if (found_argname) then
963 0 : if (want_len /= lenr) then
964 0 : ierr = ierr + 1
965 0 : msg = sjoin(argname, "requires", itoa(want_len), " tokens while found ", itoa(lenr), ch10, msg)
966 : end if
967 : else
968 0 : ierr = ierr + 1
969 0 : msg = sjoin("Cannot find --", argname, " option in CLI and want_len:", itoa(want_len), ch10, msg)
970 : end if
971 : end if
972 :
973 0 : end function get_arg_list_dp
974 : !!***
975 :
976 : !----------------------------------------------------------------------
977 :
978 : !!****f* ABINIT/parse_kargs
979 : !! NAME
980 : !! parse_kargs
981 : !!
982 : !! FUNCTION
983 : !! Parse command line arguments, return options related to k-point sampling
984 : !!
985 : !! INPUTS
986 : !!
987 : !! OUTPUT
988 : !!
989 : !! SOURCE
990 :
991 0 : subroutine parse_kargs(kptopt, kptrlatt, nshiftk, shiftk, chksymbreak)
992 :
993 : !Arguments ------------------------------------
994 : integer,intent(out) :: kptopt, nshiftk, chksymbreak
995 : integer,intent(out) :: kptrlatt(3,3)
996 : real(dp),allocatable,intent(out) :: shiftk(:,:)
997 :
998 : !Local variables-------------------------------
999 : integer :: ii, lenr, ierr
1000 : character(len=500) :: msg
1001 : integer :: ivec9(9), ngkpt(3)
1002 : real(dp) :: my_shiftk(3 * MAX_NSHIFTK)
1003 :
1004 : ! *************************************************************************
1005 :
1006 0 : ABI_CHECK(get_arg("kptopt", kptopt, msg, default=1) == 0, msg)
1007 0 : ABI_CHECK(get_arg("chksymbreak", chksymbreak, msg, default=1) == 0, msg)
1008 :
1009 0 : ierr = get_arg_list("ngkpt", ngkpt, lenr, msg, exclude="kptrlatt", want_len=3)
1010 0 : if (ierr == 0) then
1011 : !if (lenr == 3) then
1012 0 : kptrlatt = 0
1013 0 : do ii=1,3
1014 0 : kptrlatt(ii, ii) = ngkpt(ii)
1015 : end do
1016 : else
1017 0 : ABI_CHECK(get_arg_list("kptrlatt", ivec9, lenr, msg, exclude="ngkpt", want_len=9) == 0, msg)
1018 0 : ABI_CHECK(lenr == 9, "Expecting 9 values for kptrlatt")
1019 0 : kptrlatt = transpose(reshape(ivec9, [3, 3]))
1020 : end if
1021 :
1022 : ! Init default
1023 0 : ABI_CHECK(get_arg_list("shiftk", my_shiftk, lenr, msg) == 0, msg)
1024 0 : if (lenr /= 0) then
1025 0 : ABI_CHECK(mod(lenr, 3) == 0, "Expecting 3 * nshift array")
1026 0 : nshiftk = lenr / 3
1027 0 : ABI_MALLOC(shiftk, (3, nshiftk))
1028 0 : shiftk = reshape(my_shiftk(1:lenr), [3, nshiftk])
1029 : else
1030 0 : nshiftk = 1
1031 0 : ABI_CALLOC(shiftk, (3, nshiftk))
1032 : !shiftk(:, 1) = [half, half, half]
1033 : end if
1034 : !write(std_out, *)"kptopt = ", kptopt, ", chksymbreak = ", chksymbreak, ", nshiftk = ", nshiftk, ", kptrlatt = ", kptrlatt
1035 :
1036 0 : end subroutine parse_kargs
1037 : !!***
1038 :
1039 0 : end module m_argparse
1040 : !!***
|
