38 CHARACTER(len=1) :: short_opt=
''
39 CHARACTER(len=80) :: long_opt=
''
42 LOGICAL :: has_default=.false.
43 CHARACTER(len=1),
POINTER :: destc=>null()
45 INTEGER :: helpformat=0
46 INTEGER,
POINTER :: desti=>null()
48 REAL,
POINTER :: destr=>null()
50 DOUBLE PRECISION,
POINTER :: destd=>null()
52 LOGICAL,
POINTER :: destl=>null()
54 INTEGER,
POINTER :: destcount=>null()
55 INTEGER(kind=int_b),
POINTER :: help_msg(:)=>null()
58 #define ARRAYOF_ORIGTYPE TYPE(option)
59 #define ARRAYOF_TYPE arrayof_option
60 #define ARRAYOF_ORIGDESTRUCTOR(x) CALL option_delete(x)
61 #define ARRAYOF_PRIVATE 1
62 #include "arrayof_pre_nodoc.F90"
146 INTEGER(kind=int_b),
POINTER :: usage_msg(:), description_msg(:)
147 TYPE(arrayof_option
) :: options
148 LOGICAL :: httpmode=.false.
156 MODULE PROCEDURE optionparser_add_c, optionparser_add_i, optionparser_add_r, &
157 optionparser_add_d, optionparser_add_l, &
158 optionparser_add_iarray, optionparser_add_rarray, optionparser_add_darray
162 MODULE PROCEDURE option_c_e
173 MODULE PROCEDURE optionparser_delete
177 INTEGER,
PARAMETER :: opttype_c = 1, opttype_i = 2, opttype_r = 3, &
178 opttype_d = 4, opttype_l = 5, opttype_count = 6, opttype_help = 7, &
179 opttype_sep = 8, opttype_carr = 11, opttype_iarr = 12, opttype_rarr = 13, &
180 opttype_darr = 14, opttype_larr = 15
182 INTEGER,
PARAMETER :: optionparser_ok = 0
183 INTEGER,
PARAMETER :: optionparser_help = 1
184 INTEGER,
PARAMETER :: optionparser_err = 2
189 optionparser_add_count, optionparser_add_help, optionparser_add_sep, &
190 optionparser_parse, optionparser_printhelp, &
191 optionparser_ok, optionparser_help, optionparser_err
196 #include "arrayof_post_nodoc.F90"
199 FUNCTION option_new(short_opt, long_opt, default, help) RESULT(this)
200 CHARACTER(len=*),
INTENT(in) :: short_opt
201 CHARACTER(len=*),
INTENT(in) :: long_opt
202 CHARACTER(len=*),
INTENT(in) :: default
203 CHARACTER(len=*),
OPTIONAL :: help
206 IF (short_opt ==
'' .AND. long_opt ==
'')
THEN
209 CALL l4f_log(l4f_error,
'in optionparser, both short and long options empty')
210 CALL raise_fatal_error()
212 CALL l4f_log(l4f_warn,
'in optionparser, both short and long options empty')
217 this%short_opt = short_opt
218 this%long_opt = long_opt
219 IF (present(help))
THEN
220 CALL fchar_to_cstr_alloc(trim(help)//trim(default), this%help_msg)
222 this%has_default = (len_trim(default) > 0)
224 END FUNCTION option_new
229 SUBROUTINE option_delete(this)
230 TYPE(option
),
INTENT(inout) :: this
232 IF (
ASSOCIATED(this%help_msg))
DEALLOCATE(this%help_msg)
238 nullify(this%destcount)
240 END SUBROUTINE option_delete
243 FUNCTION option_found(this, optarg) RESULT(status)
244 TYPE(option
),
INTENT(inout) :: this
245 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: optarg
251 DOUBLE PRECISION :: dbuff
253 status = optionparser_ok
255 SELECT CASE(this%opttype)
257 CALL dirty_char_assignment(this%destc, this%destclen, trim(optarg))
259 IF (len_trim(optarg) > this%destclen)
THEN
260 CALL l4f_log(l4f_warn, &
261 'in optionparser, argument '''//trim(optarg)//
''' too long, truncated')
264 READ(optarg,
'(I12)',err=100)this%desti
266 CALL
delete(this%destiarr)
267 CALL
init(arrparser, optarg)
268 DO WHILE(.NOT.csv_record_end(arrparser))
270 CALL insert(this%destiarr, ibuff)
272 CALL packarray(this%destiarr)
275 READ(optarg,
'(F20.0)',err=102)this%destr
277 CALL
delete(this%destrarr)
278 CALL
init(arrparser, optarg)
279 DO WHILE(.NOT.csv_record_end(arrparser))
281 CALL insert(this%destrarr, rbuff)
283 CALL packarray(this%destrarr)
286 READ(optarg,
'(F20.0)',err=102)this%destd
288 CALL
delete(this%destdarr)
289 CALL
init(arrparser, optarg)
290 DO WHILE(.NOT.csv_record_end(arrparser))
292 CALL insert(this%destdarr, dbuff)
294 CALL packarray(this%destdarr)
299 this%destcount = this%destcount + 1
301 status = optionparser_help
303 CASE(
'md',
'markdown')
312 100 status = optionparser_err
313 CALL l4f_log(l4f_error, &
314 'in optionparser, argument '''//trim(optarg)//
''' not valid as integer')
316 102 status = optionparser_err
317 CALL l4f_log(l4f_error, &
318 'in optionparser, argument '''//trim(optarg)//
''' not valid as real')
321 END FUNCTION option_found
328 FUNCTION option_format_opt(this) RESULT(format_opt)
329 TYPE(option
),
INTENT(in) :: this
331 CHARACTER(len=100) :: format_opt
333 CHARACTER(len=20) :: argname
335 SELECT CASE(this%opttype)
341 argname =
'INT[,INT...]'
342 CASE(opttype_r, opttype_d)
344 CASE(opttype_rarr, opttype_darr)
345 argname =
'REAL[,REAL...]'
351 IF (this%short_opt /=
'')
THEN
352 format_opt(len_trim(format_opt)+1:) =
' -'//this%short_opt
353 IF (argname /=
'')
THEN
354 format_opt(len_trim(format_opt)+1:) =
' '//trim(argname)
357 IF (this%short_opt /=
'' .AND. this%long_opt /=
'')
THEN
358 format_opt(len_trim(format_opt)+1:) =
','
360 IF (this%long_opt /=
'')
THEN
361 format_opt(len_trim(format_opt)+1:) =
' --'//this%long_opt
362 IF (argname /=
'')
THEN
363 format_opt(len_trim(format_opt)+1:) =
'='//trim(argname)
367 END FUNCTION option_format_opt
371 SUBROUTINE option_format_help(this, ncols)
372 TYPE(option
),
INTENT(in) :: this
373 INTEGER,
INTENT(in) :: ncols
376 INTEGER,
PARAMETER :: indent = 10
380 IF (this%opttype == opttype_sep)
THEN
381 IF (
ASSOCIATED(this%help_msg))
THEN
385 help_line = line_split_new(cstr_to_fchar(this%help_msg), ncols)
387 DO j = 1, line_split_get_nlines(help_line)
388 WRITE(*,
'(A)')trim(line_split_get_line(help_line,j))
395 WRITE(*,
'(A)')trim(option_format_opt(this))
397 IF (
ASSOCIATED(this%help_msg))
THEN
398 help_line = line_split_new(cstr_to_fchar(this%help_msg), ncols-indent)
399 DO j = 1, line_split_get_nlines(help_line)
400 WRITE(*,
'(T10,A)')trim(line_split_get_line(help_line,j))
406 END SUBROUTINE option_format_help
410 SUBROUTINE option_format_md(this, ncols)
411 TYPE(option
),
INTENT(in) :: this
412 INTEGER,
INTENT(in) :: ncols
415 INTEGER,
PARAMETER :: indent = 2
418 IF (this%opttype == opttype_sep)
THEN
419 IF (
ASSOCIATED(this%help_msg))
THEN
420 help_line = line_split_new(cstr_to_fchar(this%help_msg), ncols)
422 DO j = 1, line_split_get_nlines(help_line)
423 WRITE(*,
'(A)')trim(line_split_get_line(help_line,j))
430 WRITE(*,
'(''`'',A,''`'')')trim(option_format_opt(this))
432 IF (
ASSOCIATED(this%help_msg))
THEN
433 help_line = line_split_new(cstr_to_fchar(this%help_msg), ncols-indent)
434 DO j = 1, line_split_get_nlines(help_line)
435 WRITE(*,
'(''> '',A)')trim(line_split_get_line(help_line,j))
442 END SUBROUTINE option_format_md
446 SUBROUTINE option_format_htmlform(this)
447 TYPE(option
),
INTENT(in) :: this
449 CHARACTER(len=80) :: opt_name, opt_id, opt_default
451 IF (.NOT.c_e(this))
RETURN
452 IF (this%long_opt ==
'')
THEN
453 opt_name = this%short_opt
454 opt_id =
'short_opt_'//this%short_opt
456 opt_name = this%long_opt
457 opt_id = this%long_opt
460 SELECT CASE(this%opttype)
462 CALL option_format_html_openspan(
'text')
464 IF (this%has_default .AND.
ASSOCIATED(this%destc) .AND. this%destclen > 0)
THEN
468 WRITE(*,
'(A)')
' value="'//trim(opt_default)//
'"'
470 CALL option_format_html_help()
471 CALL option_format_html_closespan()
473 CASE(opttype_i,opttype_r,opttype_d)
474 CALL option_format_html_openspan(
'text')
475 IF (this%has_default)
THEN
476 SELECT CASE(this%opttype)
478 WRITE(*,
'(3A)')
' value="',
t2c(this%desti),
'"'
481 WRITE(*,
'(3A)')
' value="',
t2c(this%destr),
'"'
483 WRITE(*,
'(3A)')
' value="',
t2c(this%destd),
'"'
486 CALL option_format_html_help()
487 CALL option_format_html_closespan()
492 CALL option_format_html_openspan(
'checkbox')
493 CALL option_format_html_help()
494 CALL option_format_html_closespan()
497 CALL option_format_html_openspan(
'number')
498 CALL option_format_html_help()
499 CALL option_format_html_closespan()
507 SUBROUTINE option_format_html_openspan(formtype)
508 CHARACTER(len=*),
INTENT(in) :: formtype
510 WRITE(*,
'(A)')
'<span class="libsim_optbox" id="span_'//trim(opt_id)//
'">'//trim(opt_name)//
':'
512 WRITE(*,
'(A)')
'<input class_"libsim_opt" id="'//trim(opt_id)//
'" type="'//formtype// &
513 '" name="'//trim(opt_id)//
'" '
515 END SUBROUTINE option_format_html_openspan
517 SUBROUTINE option_format_html_closespan()
519 WRITE(*,
'(A)')
'/></span>'
521 END SUBROUTINE option_format_html_closespan
523 SUBROUTINE option_format_html_help()
526 CHARACTER(len=20) :: form
528 IF (
ASSOCIATED(this%help_msg))
THEN
529 WRITE(*,
'(A,$)')
' title="'
531 help_line = line_split_new(cstr_to_fchar(this%help_msg), 80)
533 DO j = 1, line_split_get_nlines(help_line)
534 IF (j == line_split_get_nlines(help_line)) form =
'(A,''"'',$)'
535 WRITE(*,form)trim(line_split_get_line(help_line,j))
540 END SUBROUTINE option_format_html_help
542 END SUBROUTINE option_format_htmlform
545 FUNCTION option_c_e(this) RESULT(c_e)
546 TYPE(option
),
INTENT(in) :: this
550 c_e = this%long_opt /=
' ' .OR. this%short_opt /=
' '
552 END FUNCTION option_c_e
558 FUNCTION optionparser_new(usage_msg, description_msg) RESULT(this)
559 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: usage_msg
560 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: description_msg
564 IF (present(usage_msg))
THEN
565 CALL fchar_to_cstr_alloc(trim(usage_msg), this%usage_msg)
567 nullify(this%usage_msg)
569 IF (present(description_msg))
THEN
570 CALL fchar_to_cstr_alloc(trim(description_msg), this%description_msg)
572 nullify(this%description_msg)
575 END FUNCTION optionparser_new
578 SUBROUTINE optionparser_delete(this)
581 IF (
ASSOCIATED(this%usage_msg))
DEALLOCATE(this%usage_msg)
582 IF (
ASSOCIATED(this%description_msg))
DEALLOCATE(this%description_msg)
585 END SUBROUTINE optionparser_delete
595 SUBROUTINE optionparser_add_c(this, short_opt, long_opt, dest, default, help, isopt)
597 CHARACTER(len=*),
INTENT(in) :: short_opt
598 CHARACTER(len=*),
INTENT(in) :: long_opt
599 CHARACTER(len=*),
TARGET :: dest
600 CHARACTER(len=*),
OPTIONAL :: default
601 CHARACTER(len=*),
OPTIONAL :: help
602 LOGICAL,
INTENT(in),
OPTIONAL :: isopt
604 CHARACTER(LEN=60) :: cdefault
606 TYPE(option
) :: myoption
609 IF (present(default))
THEN
610 cdefault =
' [default='//
t2c(default,
'MISSING')//
']'
616 myoption = option_new(short_opt, long_opt, cdefault, help)
617 IF (.NOT.c_e(myoption))
RETURN
619 myoption%destc => dest(1:1)
620 myoption%destclen = len(dest)
621 IF (present(default)) &
622 CALL dirty_char_assignment(myoption%destc, myoption%destclen, default)
624 myoption%opttype = opttype_c
625 IF (optio_log(isopt))
THEN
626 myoption%need_arg = 1
628 myoption%need_arg = 2
631 i = arrayof_option_append(this%options, myoption)
633 END SUBROUTINE optionparser_add_c
642 SUBROUTINE optionparser_add_i(this, short_opt, long_opt, dest, default, help)
644 CHARACTER(len=*),
INTENT(in) :: short_opt
645 CHARACTER(len=*),
INTENT(in) :: long_opt
646 INTEGER,
TARGET :: dest
647 INTEGER,
OPTIONAL :: default
648 CHARACTER(len=*),
OPTIONAL :: help
650 CHARACTER(LEN=40) :: cdefault
652 TYPE(option
) :: myoption
654 IF (present(default))
THEN
655 cdefault =
' [default='//
t2c(default,
'MISSING')//
']'
661 myoption = option_new(short_opt, long_opt, cdefault, help)
662 IF (.NOT.c_e(myoption))
RETURN
664 myoption%desti => dest
665 IF (present(default)) myoption%desti = default
666 myoption%opttype = opttype_i
667 myoption%need_arg = 2
669 i = arrayof_option_append(this%options, myoption)
671 END SUBROUTINE optionparser_add_i
683 SUBROUTINE optionparser_add_iarray(this, short_opt, long_opt, dest, default, help)
685 CHARACTER(len=*),
INTENT(in) :: short_opt
686 CHARACTER(len=*),
INTENT(in) :: long_opt
687 TYPE(arrayof_integer),
TARGET :: dest
688 INTEGER,
OPTIONAL :: default(:)
689 CHARACTER(len=*),
OPTIONAL :: help
691 CHARACTER(LEN=40) :: cdefault
693 TYPE(option
) :: myoption
696 IF (present(default))
THEN
697 IF (
SIZE(default) == 1)
THEN
698 cdefault =
' [default='//trim(
to_char(default(1)))//
']'
699 ELSE IF (
SIZE(default) > 1)
THEN
700 cdefault =
' [default='//trim(
to_char(default(1)))//
',...]'
705 myoption = option_new(short_opt, long_opt, cdefault, help)
706 IF (.NOT.c_e(myoption))
RETURN
708 myoption%destiarr => dest
709 IF (present(default))
THEN
710 CALL insert(myoption%destiarr, default)
711 CALL packarray(myoption%destiarr)
713 myoption%opttype = opttype_iarr
714 myoption%need_arg = 2
716 i = arrayof_option_append(this%options, myoption)
718 END SUBROUTINE optionparser_add_iarray
727 SUBROUTINE optionparser_add_r(this, short_opt, long_opt, dest, default, help)
729 CHARACTER(len=*),
INTENT(in) :: short_opt
730 CHARACTER(len=*),
INTENT(in) :: long_opt
732 REAL,
OPTIONAL :: default
733 CHARACTER(len=*),
OPTIONAL :: help
735 CHARACTER(LEN=40) :: cdefault
737 TYPE(option
) :: myoption
739 IF (present(default))
THEN
740 cdefault =
' [default='//
t2c(default,
'MISSING')//
']'
746 myoption = option_new(short_opt, long_opt, cdefault, help)
747 IF (.NOT.c_e(myoption))
RETURN
749 myoption%destr => dest
750 IF (present(default)) myoption%destr = default
751 myoption%opttype = opttype_r
752 myoption%need_arg = 2
754 i = arrayof_option_append(this%options, myoption)
756 END SUBROUTINE optionparser_add_r
768 SUBROUTINE optionparser_add_rarray(this, short_opt, long_opt, dest, default, help)
770 CHARACTER(len=*),
INTENT(in) :: short_opt
771 CHARACTER(len=*),
INTENT(in) :: long_opt
772 TYPE(arrayof_real),
TARGET :: dest
773 REAL,
OPTIONAL :: default(:)
774 CHARACTER(len=*),
OPTIONAL :: help
776 CHARACTER(LEN=40) :: cdefault
778 TYPE(option
) :: myoption
781 IF (present(default))
THEN
782 IF (
SIZE(default) == 1)
THEN
783 cdefault =
' [default='//trim(
to_char(default(1)))//
']'
784 ELSE IF (
SIZE(default) > 1)
THEN
785 cdefault =
' [default='//trim(
to_char(default(1)))//
',...]'
790 myoption = option_new(short_opt, long_opt, cdefault, help)
791 IF (.NOT.c_e(myoption))
RETURN
793 myoption%destrarr => dest
794 IF (present(default))
THEN
795 CALL insert(myoption%destrarr, default)
796 CALL packarray(myoption%destrarr)
798 myoption%opttype = opttype_rarr
799 myoption%need_arg = 2
801 i = arrayof_option_append(this%options, myoption)
803 END SUBROUTINE optionparser_add_rarray
812 SUBROUTINE optionparser_add_d(this, short_opt, long_opt, dest, default, help)
814 CHARACTER(len=*),
INTENT(in) :: short_opt
815 CHARACTER(len=*),
INTENT(in) :: long_opt
816 DOUBLE PRECISION,
TARGET :: dest
817 DOUBLE PRECISION,
OPTIONAL :: default
818 CHARACTER(len=*),
OPTIONAL :: help
820 CHARACTER(LEN=40) :: cdefault
822 TYPE(option
) :: myoption
824 IF (present(default))
THEN
825 IF (c_e(default))
THEN
826 cdefault =
' [default='//trim(adjustl(
to_char(default,form=
'(G15.9)')))//
']'
828 cdefault =
' [default='//
t2c(default,
'MISSING')//
']'
835 myoption = option_new(short_opt, long_opt, cdefault, help)
836 IF (.NOT.c_e(myoption))
RETURN
838 myoption%destd => dest
839 IF (present(default)) myoption%destd = default
840 myoption%opttype = opttype_d
841 myoption%need_arg = 2
843 i = arrayof_option_append(this%options, myoption)
845 END SUBROUTINE optionparser_add_d
857 SUBROUTINE optionparser_add_darray(this, short_opt, long_opt, dest, default, help)
859 CHARACTER(len=*),
INTENT(in) :: short_opt
860 CHARACTER(len=*),
INTENT(in) :: long_opt
861 TYPE(arrayof_doubleprecision),
TARGET :: dest
862 DOUBLE PRECISION,
OPTIONAL :: default(:)
863 CHARACTER(len=*),
OPTIONAL :: help
865 CHARACTER(LEN=40) :: cdefault
867 TYPE(option
) :: myoption
870 IF (present(default))
THEN
871 IF (
SIZE(default) == 1)
THEN
872 cdefault =
' [default='//trim(adjustl(
to_char(default(1),form=
'(G15.9)')))//
']'
873 ELSE IF (
SIZE(default) > 1)
THEN
874 cdefault =
' [default='//trim(adjustl(
to_char(default(1),form=
'(G15.9)')))//
',...]'
879 myoption = option_new(short_opt, long_opt, cdefault, help)
880 IF (.NOT.c_e(myoption))
RETURN
882 myoption%destdarr => dest
883 IF (present(default))
THEN
884 CALL insert(myoption%destdarr, default)
885 CALL packarray(myoption%destdarr)
887 myoption%opttype = opttype_darr
888 myoption%need_arg = 2
890 i = arrayof_option_append(this%options, myoption)
892 END SUBROUTINE optionparser_add_darray
901 SUBROUTINE optionparser_add_l(this, short_opt, long_opt, dest, help)
903 CHARACTER(len=*),
INTENT(in) :: short_opt
904 CHARACTER(len=*),
INTENT(in) :: long_opt
905 LOGICAL,
TARGET :: dest
906 CHARACTER(len=*),
OPTIONAL :: help
909 TYPE(option
) :: myoption
912 myoption = option_new(short_opt, long_opt,
'', help)
913 IF (.NOT.c_e(myoption))
RETURN
915 myoption%destl => dest
916 myoption%destl = .false.
917 myoption%opttype = opttype_l
918 myoption%need_arg = 0
920 i = arrayof_option_append(this%options, myoption)
922 END SUBROUTINE optionparser_add_l
929 SUBROUTINE optionparser_add_count(this, short_opt, long_opt, dest, start, help)
931 CHARACTER(len=*),
INTENT(in) :: short_opt
932 CHARACTER(len=*),
INTENT(in) :: long_opt
933 INTEGER,
TARGET :: dest
934 INTEGER,
OPTIONAL :: start
935 CHARACTER(len=*),
OPTIONAL :: help
938 TYPE(option
) :: myoption
941 myoption = option_new(short_opt, long_opt,
'', help)
942 IF (.NOT.c_e(myoption))
RETURN
944 myoption%destcount => dest
945 IF (present(start)) myoption%destcount = start
946 myoption%opttype = opttype_count
947 myoption%need_arg = 0
949 i = arrayof_option_append(this%options, myoption)
951 END SUBROUTINE optionparser_add_count
968 SUBROUTINE optionparser_add_help(this, short_opt, long_opt, help)
970 CHARACTER(len=*),
INTENT(in) :: short_opt
971 CHARACTER(len=*),
INTENT(in) :: long_opt
972 CHARACTER(len=*),
OPTIONAL :: help
975 TYPE(option
) :: myoption
978 myoption = option_new(short_opt, long_opt,
'', help)
979 IF (.NOT.c_e(myoption))
RETURN
981 myoption%opttype = opttype_help
982 myoption%need_arg = 1
984 i = arrayof_option_append(this%options, myoption)
986 END SUBROUTINE optionparser_add_help
999 SUBROUTINE optionparser_add_sep(this, help)
1003 CHARACTER(len=*) :: help
1006 TYPE(option
) :: myoption
1009 myoption = option_new(
'_',
'_',
'', help)
1010 IF (.NOT.c_e(myoption))
RETURN
1012 myoption%opttype = opttype_sep
1013 myoption%need_arg = 0
1015 i = arrayof_option_append(this%options, myoption)
1017 END SUBROUTINE optionparser_add_sep
1029 SUBROUTINE optionparser_parse(this, nextarg, status)
1031 INTEGER,
INTENT(out) :: nextarg
1032 INTEGER,
INTENT(out) :: status
1034 INTEGER :: i, j, endopt, indeq, iargc
1035 CHARACTER(len=16384) :: arg, optarg
1037 status = optionparser_ok
1039 DO WHILE(i <= iargc())
1041 IF (arg ==
'--')
THEN
1044 ELSE IF (arg ==
'-')
THEN
1046 ELSE IF (arg(1:2) ==
'--')
THEN
1047 indeq =
index(arg,
'=')
1048 IF (indeq /= 0)
THEN
1051 endopt = len_trim(arg)
1053 find_longopt:
DO j = 1, this%options%arraysize
1054 IF (this%options%array(j)%long_opt == arg(3:endopt))
THEN
1055 SELECT CASE(this%options%array(j)%need_arg)
1057 IF (indeq /= 0)
THEN
1058 optarg = arg(indeq+1:)
1059 status = max(option_found(this%options%array(j), optarg), &
1062 IF (i < iargc())
THEN
1064 CALL getarg(i, optarg)
1065 status = max(option_found(this%options%array(j), optarg), &
1068 status = optionparser_err
1069 CALL l4f_log(l4f_error, &
1070 'in optionparser, option '''//trim(arg)//
''' requires an argument')
1074 IF (indeq /= 0)
THEN
1075 optarg = arg(indeq+1:)
1077 IF (i < iargc())
THEN
1078 CALL getarg(i+1, optarg)
1079 IF (optarg(1:1) ==
'-')
THEN
1088 status = max(option_found(this%options%array(j), optarg), &
1091 status = max(option_found(this%options%array(j)), &
1097 IF (j > this%options%arraysize)
THEN
1098 status = optionparser_err
1099 CALL l4f_log(l4f_error, &
1100 'in optionparser, option '''//trim(arg)//
''' not valid')
1102 ELSE IF (arg(1:1) ==
'-')
THEN
1103 find_shortopt:
DO j = 1, this%options%arraysize
1104 IF (this%options%array(j)%short_opt == arg(2:2))
THEN
1105 SELECT CASE(this%options%array(j)%need_arg)
1107 IF (len_trim(arg) > 2)
THEN
1109 status = max(option_found(this%options%array(j), optarg), &
1112 IF (i < iargc())
THEN
1114 CALL getarg(i, optarg)
1115 status = max(option_found(this%options%array(j), optarg), &
1118 status = optionparser_err
1119 CALL l4f_log(l4f_error, &
1120 'in optionparser, option '''//trim(arg)//
''' requires an argument')
1124 IF (len_trim(arg) > 2)
THEN
1127 IF (i < iargc())
THEN
1128 CALL getarg(i+1, optarg)
1129 IF (optarg(1:1) ==
'-')
THEN
1138 status = max(option_found(this%options%array(j), optarg), &
1141 status = max(option_found(this%options%array(j)), &
1147 IF (j > this%options%arraysize)
THEN
1148 status = optionparser_err
1149 CALL l4f_log(l4f_error, &
1150 'in optionparser, option '''//trim(arg)//
''' not valid')
1160 CASE(optionparser_err, optionparser_help)
1161 CALL optionparser_printhelp(this)
1164 END SUBROUTINE optionparser_parse
1170 SUBROUTINE optionparser_printhelp(this)
1176 DO i = 1, this%options%arraysize
1177 IF (this%options%array(i)%opttype == opttype_help)
THEN
1178 form = this%options%array(i)%helpformat
1184 CALL optionparser_printhelptxt(this)
1186 CALL optionparser_printhelpmd(this)
1188 CALL optionparser_printhelphtmlform(this)
1191 END SUBROUTINE optionparser_printhelp
1197 SUBROUTINE optionparser_printhelptxt(this)
1200 INTEGER :: i, j, ncols
1201 CHARACTER(len=80) :: buf
1204 ncols = default_columns()
1207 IF (
ASSOCIATED(this%usage_msg))
THEN
1208 help_line = line_split_new(cstr_to_fchar(this%usage_msg), ncols)
1209 DO j = 1, line_split_get_nlines(help_line)
1210 WRITE(*,
'(A)')trim(line_split_get_line(help_line,j))
1215 i =
index(buf,
'/', back=.true.)
1216 IF (buf(i+1:i+3) ==
'lt-') i = i + 3
1217 WRITE(*,
'(A)')
'Usage: '//trim(buf(i+1:))//
' [options] [arguments]'
1221 IF (
ASSOCIATED(this%description_msg))
THEN
1223 help_line = line_split_new(cstr_to_fchar(this%description_msg), ncols)
1224 DO j = 1, line_split_get_nlines(help_line)
1225 WRITE(*,
'(A)')trim(line_split_get_line(help_line,j))
1230 WRITE(*,
'(/,A)')
'Options:'
1232 DO i = 1, this%options%arraysize
1233 CALL option_format_help(this%options%array(i), ncols)
1236 END SUBROUTINE optionparser_printhelptxt
1242 SUBROUTINE optionparser_printhelpmd(this)
1245 INTEGER :: i, j, ncols
1246 CHARACTER(len=80) :: buf
1249 ncols = default_columns()
1252 WRITE(*,
'(A)')
'### Synopsis'
1254 IF (
ASSOCIATED(this%usage_msg))
THEN
1255 help_line = line_split_new(mdquote_usage_msg(cstr_to_fchar(this%usage_msg)), ncols)
1256 DO j = 1, line_split_get_nlines(help_line)
1257 WRITE(*,
'(A)')trim(line_split_get_line(help_line,j))
1263 IF (buf(i+1:i+3) ==
'lt-') i = i + 3
1264 WRITE(*,
'(A)')
'Usage: `'//trim(buf(i+1:))//
' [options] [arguments]`'
1268 IF (
ASSOCIATED(this%description_msg))
THEN
1270 WRITE(*,
'(A)')
'### Description'
1271 help_line = line_split_new(cstr_to_fchar(this%description_msg), ncols)
1272 DO j = 1, line_split_get_nlines(help_line)
1273 WRITE(*,
'(A)')trim(line_split_get_line(help_line,j))
1279 WRITE(*,
'(/,A)')
'### Options'
1281 DO i = 1, this%options%arraysize
1282 CALL option_format_md(this%options%array(i), ncols)
1287 FUNCTION mdquote_usage_msg(usage_msg)
1288 CHARACTER(len=*),
INTENT(in) :: usage_msg
1290 CHARACTER(len=LEN(usage_msg)+2) :: mdquote_usage_msg
1293 colon =
index(usage_msg,
':')
1294 IF (colon > 0 .AND. colon < len(usage_msg)-1)
THEN
1295 mdquote_usage_msg = usage_msg(:colon+1)//
'`'//usage_msg(colon+2:)//
'`'
1297 mdquote_usage_msg = usage_msg
1300 END FUNCTION mdquote_usage_msg
1302 END SUBROUTINE optionparser_printhelpmd
1307 SUBROUTINE optionparser_printhelphtmlform(this)
1312 DO i = 1, this%options%arraysize
1313 CALL option_format_htmlform(this%options%array(i))
1316 WRITE(*,
'(A)')
'<input class="libsim_sub" type="submit" value="runprogram" />'
1318 END SUBROUTINE optionparser_printhelphtmlform
1321 SUBROUTINE optionparser_make_completion(this)
1325 CHARACTER(len=512) :: buf
1329 WRITE(*,
'(A/A/A)')
'_'//trim(buf)//
'()',
'{',
'local cur'
1331 WRITE(*,
'(A/A/A/A)')
'COMPREPLY=()',
'cur=${COMP_WORDS[COMP_CWORD]}', &
1332 'case "$cur" in',
'-*)'
1336 DO i = 1, this%options%arraysize
1337 IF (this%options%array(i)%need_arg == 2)
THEN
1341 WRITE(*,
'(A/A/A)')
'esac',
'return 0',
'}'
1343 END SUBROUTINE optionparser_make_completion
1346 SUBROUTINE dirty_char_assignment(destc, destclen, src)
1350 CHARACTER(len=1) :: destc(*)
1351 CHARACTER(len=*) :: src
1356 DO i = 1, min(destclen, len(src))
1359 DO i = len(src)+1, destclen
1363 END SUBROUTINE dirty_char_assignment
Derived type defining a dynamically extensible array of INTEGER elements.
Functions that return a trimmed CHARACTER representation of the input variable.
Destructor for the optionparser class.
Derived type defining a dynamically extensible array of REAL elements.
Methods for successively obtaining the fields of a csv_record object.
Derived type defining a dynamically extensible array of LOGICAL elements.
Module for parsing command-line optons.
Restituiscono il valore dell'oggetto in forma di stringa stampabile.
Derived type defining a dynamically extensible array of DOUBLEPRECISION elements. ...
Costruttori per le classi datetime e timedelta.
Class for interpreting the records of a csv file.
classe per la gestione del logging
Utilities for CHARACTER variables.
Class that allows splitting a long line into shorter lines of equal length at the occurrence of a spe...
Definition of constants to be used for declaring variables of a desired type.
Utilities for managing files.
This module defines usefull general purpose function and subroutine.
Add a new option of a specific type.
This class allows to parse the command-line options of a program in an object-oriented way...