233 type(OPT_ENTRY),
pointer :: opt_table(:) => null()
236 logical :: initialized = .false.
239 type(cmd_opts_internal),
pointer :: cmd_opts_list(:) => null()
254 character(STRING),
pointer:: options(:) => null()
257 character(STRING) :: help_message
260 logical :: optvalue_flag
271 type cmd_opts_internal
272 character(STRING) :: name
275 character(STRING) :: value
278 logical:: flag_called = .false.
281 end type cmd_opts_internal
284 module procedure dcargsopen0
288 module procedure dcargsclose0
292 module procedure dcargsoption0
296 module procedure dcargsputline0
300 module procedure dcargsdebug0
304 module procedure dcargshelp0
308 module procedure dcargshelpmsg0
312 module procedure dcargsstrict0
316 module procedure dcargsget0
320 module procedure dcargsnumber0
327 module procedure dcargsopen0
331 module procedure dcargsclose0
335 module procedure dcargsoption0
339 module procedure dcargsputline0
343 module procedure dcargsdebug0
347 module procedure dcargshelp0
351 module procedure dcargshelpmsg0
355 module procedure dcargsstrict0
359 module procedure dcargsget0
363 module procedure dcargsnumber0
371 character(STRING),
allocatable,
save:: argstr_table(:)
377 integer,
save:: argind_count = -1
385 type(CMD_OPTS_INTERNAL),
allocatable,
save :: cmd_opts_list(:)
391 character(STRING),
allocatable,
save:: cmd_argv_list(:)
427 subroutine dcargsopen0(arg)
430 type(
args),
intent(out) :: arg
431 integer:: cmd_opts_max
432 character(len = *),
parameter :: subname =
'DCArgsOpen'
434 if (arg % initialized)
then
435 call messagenotify(
'W', subname,
'This argument (type ARGS) is already opend.')
440 cmd_opts_max =
size(cmd_opts_list)
441 allocate(arg % cmd_opts_list(cmd_opts_max))
442 arg % cmd_opts_list = cmd_opts_list
443 nullify( arg % opt_table )
444 arg % initialized = .true.
445 end subroutine dcargsopen0
462 subroutine dcargsclose0(arg)
465 type(
args),
intent(inout) :: arg
468 if (arg % initialized)
then
469 if (
associated( arg % opt_table ) )
then
470 do i = 1,
size(arg % opt_table)
471 deallocate(arg % opt_table(i) % options)
474 deallocate(arg % opt_table)
477 deallocate(arg % cmd_opts_list)
478 deallocate(argstr_table)
479 deallocate(cmd_argv_list)
480 deallocate(cmd_opts_list)
484 end subroutine dcargsclose0
558 subroutine dcargsoption0(arg, options, flag, value, help)
561 type(
args),
intent(inout) :: arg
562 character(len = *),
intent(in) :: options(:)
563 logical,
intent(out) :: flag
564 character(len = *),
intent(out),
optional :: value
565 character(len = *),
intent(in),
optional :: help
566 integer :: i, j, options_size, table_size
567 type(opt_entry),
allocatable :: local_tables(:)
568 character(len = STRING) :: opt_name, opt_value, opt_full
569 character(len = *),
parameter :: subname =
'DCArgsOption'
572 if (
present(
value))
value =
''
573 if (.not. arg % initialized)
then
574 call messagenotify(
'W', subname,
'Call Open before Option in dc_args.')
577 options_size =
size(options)
578 if (options_size < 1)
then
586 if ( .not.
associated( arg % opt_table ) )
then
590 allocate(arg % opt_table(table_size + 1))
594 table_size =
size(arg % opt_table)
595 allocate(local_tables(table_size))
596 local_tables(1:table_size) = arg % opt_table(1:table_size)
597 deallocate(arg % opt_table)
598 allocate(arg % opt_table(table_size + 1))
599 arg % opt_table(1:table_size) = local_tables(1:table_size)
600 deallocate(local_tables)
604 allocate(arg % opt_table(table_size + 1) % options(options_size))
605 arg % opt_table(table_size + 1) % options = options
606 arg % opt_table(table_size + 1) % help_message =
''
607 if (
present(
help))
then
608 arg % opt_table(table_size + 1) % help_message =
help
610 arg % opt_table(table_size + 1) % optvalue_flag =
present(
value)
614 do i = 1, options_size
615 opt_full = arg % opt_table(table_size + 1) % options(i)
616 if (dcoptionformc(opt_full, opt_name, opt_value))
then
617 arg % opt_table(table_size + 1) % options(i) = opt_name
619 if (len(trim(adjustl(opt_full))) < 2)
then
620 arg % opt_table(table_size + 1) % options(i) = &
621 &
'-' // trim(adjustl(opt_full))
623 arg % opt_table(table_size + 1) % options(i) = &
624 &
'--' // trim(adjustl(opt_full))
632 do i = 1, options_size
633 do j = 1,
size(arg % cmd_opts_list)
634 if (trim(arg % opt_table(table_size + 1) % options(i)) &
635 & == trim(arg % cmd_opts_list(j) % name))
then
637 if (
present(
value))
then
638 value = arg % cmd_opts_list(j) % value
640 arg % cmd_opts_list(j) % flag_called = .true.
644 end subroutine dcargsoption0
667 subroutine dcargsdebug0(arg)
673 type(
args),
intent(inout) :: arg
675 character(STRING) :: VAL_debug
676 character(len = *),
parameter :: subname =
'DCArgsDebug'
678 if (.not. arg % initialized)
then
679 call messagenotify(
'W', subname,
'Call Open before Debug in dc_args.')
682 call option(arg,
stoa(
'-D',
'--debug'), opt_debug, val_debug, &
683 &
help=
"call dc_trace#SetDebug (display a lot of messages for debug). " // &
684 &
"VAL is unit number (default is standard output)")
686 if (trim(val_debug) ==
'')
then
693 end subroutine dcargsdebug0
737 subroutine dcargshelp0(arg, force)
744 type(
args),
intent(inout) :: arg
745 logical,
intent(in),
optional :: force
746 logical :: OPT_help, found, end
747 character(STRING) :: VAL_help, options_msg, help_msg, category
748 character(STRING),
pointer :: localopts(:) => null()
750 character(len = *),
parameter :: subname =
'DCArgsHelp'
752 if (.not. arg % initialized)
then
753 call messagenotify(
'W', subname,
'Call Open before Help in dc_args.')
757 &
help=
"display this help and exit. " // &
758 &
"VAL is unit number (default is standard output)")
762 if (trim(val_help) ==
'')
then
765 unit =
stoi(val_help)
770 call dchashget(arg % helpmsg,
'TITLE', help_msg, found)
772 call printf(unit,
'%c', c1=trim(help_msg))
777 call dchashget(arg % helpmsg,
'OVERVIEW', help_msg, found)
779 call printf(unit,
'Overview::')
780 call printautolinefeed(unit, help_msg, indent=
' ')
785 call dchashget(arg % helpmsg,
'USAGE', help_msg, found)
787 call printf(unit,
'Usage::')
788 call printautolinefeed(unit, help_msg, indent=
' ')
793 call printf(unit,
'Options::')
794 if (
associated(arg % opt_table) )
then
795 do i = 1,
size(arg % opt_table)
797 if (arg % opt_table(i) % optvalue_flag)
then
798 call concat(arg % opt_table(i) % options,
'=VAL', localopts)
800 allocate(localopts(
size(arg % opt_table(i) % options)))
801 localopts = arg % opt_table(i) % options
803 options_msg = trim(options_msg) // trim(
joinchar(localopts))
804 deallocate(localopts)
805 call printf(unit,
' %c', c1=trim(options_msg))
806 call printautolinefeed(unit, &
807 & arg % opt_table(i) % help_message, indent=
' ')
814 call dchashnext(arg % helpmsg, category, help_msg,
end)
817 call printf(unit,
'%c%c::', &
818 & c1=trim(uchar(category(1:1))), c2=trim(lchar(category(2:))))
819 call printautolinefeed(unit, help_msg, indent=
' ')
820 call printf(unit,
'')
827 end subroutine dcargshelp0
939 subroutine dcargshelpmsg0(arg, category, msg)
944 type(
args),
intent(inout) :: arg
945 character(*),
intent(in) :: category
946 character(*),
intent(in) :: msg
947 character(len = *),
parameter :: subname =
'DCArgsHelpMsg'
949 if (.not. arg % initialized)
then
950 call messagenotify(
'W', subname,
'Call Open before Help in dc_args.')
954 end subroutine dcargshelpmsg0
996 subroutine dcargsstrict0(arg, severe)
1001 type(
args),
intent(inout) :: arg
1002 logical,
intent(in),
optional :: severe
1003 character(STRING) :: err_mess
1005 character(len = *),
parameter :: subname =
'DCArgsStrict'
1007 if (.not. arg % initialized)
then
1008 call messagenotify(
'W', subname,
'Call Open before Help in dc_args.')
1011 do i = 1,
size(arg % cmd_opts_list)
1012 err_mess = trim(arg % cmd_opts_list(i) % name) //
' is invalid option.'
1013 if (.not. arg % cmd_opts_list(i) % flag_called)
then
1021 end subroutine dcargsstrict0
1048 subroutine dcargsget0(arg, argv)
1053 type(
args),
intent(inout) :: arg
1054 character(*),
pointer :: argv(:)
1055 integer :: i, cmd_argv_max
1056 character(len = *),
parameter :: subname =
'DCArgsGet'
1058 if (.not. arg % initialized)
then
1059 call messagenotify(
'W', subname,
'Call Open before Help in dc_args.')
1062 cmd_argv_max =
size(cmd_argv_list)
1063 allocate(argv(cmd_argv_max))
1064 do i = 1, cmd_argv_max
1065 argv(i) = cmd_argv_list(i)
1067 end subroutine dcargsget0
1086 function dcargsnumber0(arg)
result(result)
1089 type(
args),
intent(inout) :: arg
1091 character(len = *),
parameter :: subname =
'DCArgsNumber'
1093 if (.not. arg % initialized)
then
1094 call messagenotify(
'W', subname,
'Call Open before Help in dc_args.')
1097 result =
size(cmd_argv_list)
1098 end function dcargsnumber0
1117 subroutine dcargsputline0(arg)
1121 type(
args),
intent(in) :: arg
1124 if (.not. arg % initialized)
then
1125 call printf(
stdout,
'#<ARGS:: @initialized=%y>', l=(/arg % initialized/))
1128 call printf(
stdout,
'#<ARGS:: @initialized=%y,', l=(/arg % initialized/))
1130 if (
associated(arg % opt_table) )
then
1131 do i = 1,
size(arg % opt_table)
1133 call printf(
stdout,
' @options=%c, @help_message=%c, @optvalue_flag=%y', &
1134 & c1=trim(
joinchar(arg % opt_table(i) % options)), &
1135 & c2=trim(arg % opt_table(i) % help_message), &
1136 & l=(/arg % opt_table(i) % optvalue_flag/))
1142 do i = 1,
size(arg % cmd_opts_list)
1144 call printf(
stdout,
' @name=%c, @value=%c, @flag_called=%y', &
1145 & c1=trim(arg % cmd_opts_list(i) % name), &
1146 & c2=trim(arg % cmd_opts_list(i) % value), &
1147 & l=(/arg % cmd_opts_list(i) % flag_called/))
1152 & c1=trim(
joinchar(cmd_argv_list)))
1155 end subroutine dcargsputline0
1192 subroutine printautolinefeed(unit, fmt, length, indent)
1196 character(*),
intent(in) :: fmt
1197 integer,
intent(in),
optional :: length
1198 character(*),
intent(in),
optional :: indent
1199 integer,
intent(in),
optional :: unit
1200 character(STRING),
pointer :: carray_tmp(:) => null()
1201 character(STRING) :: store_str
1202 integer,
parameter :: default_len = 70
1203 integer :: i, split_len, indent_len, unit_num
1204 logical :: new_line_flag
1206 if (
present(unit))
then
1212 if (
present(indent))
then
1213 indent_len = len(indent)
1218 if (
present(length))
then
1219 split_len = length - indent_len
1221 split_len = default_len - indent_len
1226 call split(fmt, carray_tmp,
'')
1228 new_line_flag = .true.
1231 if (i >
size(carray_tmp))
then
1232 write(unit_num,
'(A)') trim(store_str)
1236 if (len(trim(store_str)) + len(trim(carray_tmp(i))) > split_len)
then
1237 if (new_line_flag)
then
1238 write(unit_num,
'(A)') trim(carray_tmp(i))
1241 write(unit_num,
'(A)') trim(store_str)
1243 new_line_flag = .true.
1248 if (new_line_flag .and.
present(indent))
then
1249 store_str = indent // trim(carray_tmp(i))
1251 store_str = trim(store_str) //
' ' // trim(carray_tmp(i))
1253 new_line_flag = .false.
1257 end subroutine printautolinefeed
1280 subroutine sortargtable
1283 character(STRING):: raw_arg, name, value
1284 integer:: i, cmd_argv_count, cmd_opts_count, cmd_argv_max, cmd_opts_max
1286 if (
allocated(cmd_opts_list))
return
1289 check_count:
do, i = 1, argind_count
1290 raw_arg = argstr_table(i)
1291 if (dcoptionformc(raw_arg, name,
value))
then
1292 cmd_opts_count = cmd_opts_count + 1
1294 cmd_argv_count = cmd_argv_count + 1
1298 cmd_argv_max = cmd_argv_count
1299 cmd_opts_max = cmd_opts_count
1301 allocate(cmd_argv_list(cmd_argv_max))
1302 allocate(cmd_opts_list(cmd_opts_max))
1306 arg_get :
do, i = 1, argind_count
1307 raw_arg = argstr_table(i)
1308 if (dcoptionformc(raw_arg, name,
value))
then
1309 cmd_opts_count = cmd_opts_count + 1
1310 cmd_opts_list(cmd_opts_count) % name = name
1311 cmd_opts_list(cmd_opts_count) % value =
value
1312 cmd_opts_list(cmd_opts_count) % flag_called = .false.
1314 cmd_argv_count = cmd_argv_count + 1
1315 cmd_argv_list(cmd_argv_count) = raw_arg
1318 end subroutine sortargtable
1341 subroutine buildargtable
1345 integer:: i, narg, nargmax
1346 character(len = STRING):: value
1347 character(len = STRING),
allocatable:: localtab(:)
1349 if (argind_count >= 0)
return
1351 allocate(localtab(nargmax))
1356 localtab(narg) =
value
1359 allocate(argstr_table(narg))
1360 argstr_table(1: narg) = localtab(1: narg)
1361 deallocate(localtab)
1362 end subroutine buildargtable
1441 function dcoptionformc(argument, name, value)
result(result)
1443 character(len = *),
intent(in):: argument
1444 character(len = *),
intent(out):: name, value
1448 equal = index(argument,
'=')
1449 if (argument(1:1) ==
'-' .and. argument(2:2) /=
'-')
then
1451 if (equal == 0)
then
1452 name = argument(1:2)
1455 name = argument(1:2)
1456 value = argument(equal+1: )
1459 elseif (argument(1:2) ==
'--')
then
1461 if (equal == 0)
then
1465 name = argument(1:equal-1)
1466 value = argument(equal+1: )
1481 end function dcoptionformc
Command line arguments parser.
Hash (associative array) module.
Judge optional control parameters.
logical function, public present_and_true(arg)
Handling character types.
character(string) function, public joinchar(carray, expr)
subroutine, public setdebug(debug)
Provides kind type parameter values.
integer, parameter, public string
Character length for string
integer, parameter, public stdout
Unit number for Standard OUTPUT
Provides interface for system dependent procedures.
subroutine, public sysdepargget(index, val)
Get command line argument.
integer function, public sysdepargcount()
Get number of command line arguments.