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, optarg, len_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
621 CALL dirty_char_pointer_set(myoption%destc, dest(1:1))
623 myoption%destclen = len(dest)
624 IF (present(default)) &
625 CALL dirty_char_assignment(myoption%destc, myoption%destclen, default, len(default))
627 myoption%opttype = opttype_c
628 IF (optio_log(isopt))
THEN
629 myoption%need_arg = 1
631 myoption%need_arg = 2
634 i = arrayof_option_append(this%options, myoption)
636 END SUBROUTINE optionparser_add_c
645 SUBROUTINE optionparser_add_i(this, short_opt, long_opt, dest, default, help)
647 CHARACTER(len=*),
INTENT(in) :: short_opt
648 CHARACTER(len=*),
INTENT(in) :: long_opt
649 INTEGER,
TARGET :: dest
650 INTEGER,
OPTIONAL :: default
651 CHARACTER(len=*),
OPTIONAL :: help
653 CHARACTER(LEN=40) :: cdefault
655 TYPE(option
) :: myoption
657 IF (present(default))
THEN
658 cdefault =
' [default='//
t2c(default,
'MISSING')//
']'
664 myoption = option_new(short_opt, long_opt, cdefault, help)
665 IF (.NOT.c_e(myoption))
RETURN
667 myoption%desti => dest
668 IF (present(default)) myoption%desti = default
669 myoption%opttype = opttype_i
670 myoption%need_arg = 2
672 i = arrayof_option_append(this%options, myoption)
674 END SUBROUTINE optionparser_add_i
686 SUBROUTINE optionparser_add_iarray(this, short_opt, long_opt, dest, default, help)
688 CHARACTER(len=*),
INTENT(in) :: short_opt
689 CHARACTER(len=*),
INTENT(in) :: long_opt
690 TYPE(arrayof_integer),
TARGET :: dest
691 INTEGER,
OPTIONAL :: default(:)
692 CHARACTER(len=*),
OPTIONAL :: help
694 CHARACTER(LEN=40) :: cdefault
696 TYPE(option
) :: myoption
699 IF (present(default))
THEN
700 IF (
SIZE(default) == 1)
THEN
701 cdefault =
' [default='//trim(
to_char(default(1)))//
']'
702 ELSE IF (
SIZE(default) > 1)
THEN
703 cdefault =
' [default='//trim(
to_char(default(1)))//
',...]'
708 myoption = option_new(short_opt, long_opt, cdefault, help)
709 IF (.NOT.c_e(myoption))
RETURN
711 myoption%destiarr => dest
712 IF (present(default))
THEN
713 CALL insert(myoption%destiarr, default)
714 CALL packarray(myoption%destiarr)
716 myoption%opttype = opttype_iarr
717 myoption%need_arg = 2
719 i = arrayof_option_append(this%options, myoption)
721 END SUBROUTINE optionparser_add_iarray
730 SUBROUTINE optionparser_add_r(this, short_opt, long_opt, dest, default, help)
732 CHARACTER(len=*),
INTENT(in) :: short_opt
733 CHARACTER(len=*),
INTENT(in) :: long_opt
735 REAL,
OPTIONAL :: default
736 CHARACTER(len=*),
OPTIONAL :: help
738 CHARACTER(LEN=40) :: cdefault
740 TYPE(option
) :: myoption
742 IF (present(default))
THEN
743 cdefault =
' [default='//
t2c(default,
'MISSING')//
']'
749 myoption = option_new(short_opt, long_opt, cdefault, help)
750 IF (.NOT.c_e(myoption))
RETURN
752 myoption%destr => dest
753 IF (present(default)) myoption%destr = default
754 myoption%opttype = opttype_r
755 myoption%need_arg = 2
757 i = arrayof_option_append(this%options, myoption)
759 END SUBROUTINE optionparser_add_r
771 SUBROUTINE optionparser_add_rarray(this, short_opt, long_opt, dest, default, help)
773 CHARACTER(len=*),
INTENT(in) :: short_opt
774 CHARACTER(len=*),
INTENT(in) :: long_opt
775 TYPE(arrayof_real),
TARGET :: dest
776 REAL,
OPTIONAL :: default(:)
777 CHARACTER(len=*),
OPTIONAL :: help
779 CHARACTER(LEN=40) :: cdefault
781 TYPE(option
) :: myoption
784 IF (present(default))
THEN
785 IF (
SIZE(default) == 1)
THEN
786 cdefault =
' [default='//trim(
to_char(default(1)))//
']'
787 ELSE IF (
SIZE(default) > 1)
THEN
788 cdefault =
' [default='//trim(
to_char(default(1)))//
',...]'
793 myoption = option_new(short_opt, long_opt, cdefault, help)
794 IF (.NOT.c_e(myoption))
RETURN
796 myoption%destrarr => dest
797 IF (present(default))
THEN
798 CALL insert(myoption%destrarr, default)
799 CALL packarray(myoption%destrarr)
801 myoption%opttype = opttype_rarr
802 myoption%need_arg = 2
804 i = arrayof_option_append(this%options, myoption)
806 END SUBROUTINE optionparser_add_rarray
815 SUBROUTINE optionparser_add_d(this, short_opt, long_opt, dest, default, help)
817 CHARACTER(len=*),
INTENT(in) :: short_opt
818 CHARACTER(len=*),
INTENT(in) :: long_opt
819 DOUBLE PRECISION,
TARGET :: dest
820 DOUBLE PRECISION,
OPTIONAL :: default
821 CHARACTER(len=*),
OPTIONAL :: help
823 CHARACTER(LEN=40) :: cdefault
825 TYPE(option
) :: myoption
827 IF (present(default))
THEN
828 IF (c_e(default))
THEN
829 cdefault =
' [default='//trim(adjustl(
to_char(default,form=
'(G15.9)')))//
']'
831 cdefault =
' [default='//
t2c(default,
'MISSING')//
']'
838 myoption = option_new(short_opt, long_opt, cdefault, help)
839 IF (.NOT.c_e(myoption))
RETURN
841 myoption%destd => dest
842 IF (present(default)) myoption%destd = default
843 myoption%opttype = opttype_d
844 myoption%need_arg = 2
846 i = arrayof_option_append(this%options, myoption)
848 END SUBROUTINE optionparser_add_d
860 SUBROUTINE optionparser_add_darray(this, short_opt, long_opt, dest, default, help)
862 CHARACTER(len=*),
INTENT(in) :: short_opt
863 CHARACTER(len=*),
INTENT(in) :: long_opt
864 TYPE(arrayof_doubleprecision),
TARGET :: dest
865 DOUBLE PRECISION,
OPTIONAL :: default(:)
866 CHARACTER(len=*),
OPTIONAL :: help
868 CHARACTER(LEN=40) :: cdefault
870 TYPE(option
) :: myoption
873 IF (present(default))
THEN
874 IF (
SIZE(default) == 1)
THEN
875 cdefault =
' [default='//trim(adjustl(
to_char(default(1),form=
'(G15.9)')))//
']'
876 ELSE IF (
SIZE(default) > 1)
THEN
877 cdefault =
' [default='//trim(adjustl(
to_char(default(1),form=
'(G15.9)')))//
',...]'
882 myoption = option_new(short_opt, long_opt, cdefault, help)
883 IF (.NOT.c_e(myoption))
RETURN
885 myoption%destdarr => dest
886 IF (present(default))
THEN
887 CALL insert(myoption%destdarr, default)
888 CALL packarray(myoption%destdarr)
890 myoption%opttype = opttype_darr
891 myoption%need_arg = 2
893 i = arrayof_option_append(this%options, myoption)
895 END SUBROUTINE optionparser_add_darray
904 SUBROUTINE optionparser_add_l(this, short_opt, long_opt, dest, help)
906 CHARACTER(len=*),
INTENT(in) :: short_opt
907 CHARACTER(len=*),
INTENT(in) :: long_opt
908 LOGICAL,
TARGET :: dest
909 CHARACTER(len=*),
OPTIONAL :: help
912 TYPE(option
) :: myoption
915 myoption = option_new(short_opt, long_opt,
'', help)
916 IF (.NOT.c_e(myoption))
RETURN
918 myoption%destl => dest
919 myoption%destl = .false.
920 myoption%opttype = opttype_l
921 myoption%need_arg = 0
923 i = arrayof_option_append(this%options, myoption)
925 END SUBROUTINE optionparser_add_l
932 SUBROUTINE optionparser_add_count(this, short_opt, long_opt, dest, start, help)
934 CHARACTER(len=*),
INTENT(in) :: short_opt
935 CHARACTER(len=*),
INTENT(in) :: long_opt
936 INTEGER,
TARGET :: dest
937 INTEGER,
OPTIONAL :: start
938 CHARACTER(len=*),
OPTIONAL :: help
941 TYPE(option
) :: myoption
944 myoption = option_new(short_opt, long_opt,
'', help)
945 IF (.NOT.c_e(myoption))
RETURN
947 myoption%destcount => dest
948 IF (present(start)) myoption%destcount = start
949 myoption%opttype = opttype_count
950 myoption%need_arg = 0
952 i = arrayof_option_append(this%options, myoption)
954 END SUBROUTINE optionparser_add_count
971 SUBROUTINE optionparser_add_help(this, short_opt, long_opt, help)
973 CHARACTER(len=*),
INTENT(in) :: short_opt
974 CHARACTER(len=*),
INTENT(in) :: long_opt
975 CHARACTER(len=*),
OPTIONAL :: help
978 TYPE(option
) :: myoption
981 myoption = option_new(short_opt, long_opt,
'', help)
982 IF (.NOT.c_e(myoption))
RETURN
984 myoption%opttype = opttype_help
985 myoption%need_arg = 1
987 i = arrayof_option_append(this%options, myoption)
989 END SUBROUTINE optionparser_add_help
1002 SUBROUTINE optionparser_add_sep(this, help)
1006 CHARACTER(len=*) :: help
1009 TYPE(option
) :: myoption
1012 myoption = option_new(
'_',
'_',
'', help)
1013 IF (.NOT.c_e(myoption))
RETURN
1015 myoption%opttype = opttype_sep
1016 myoption%need_arg = 0
1018 i = arrayof_option_append(this%options, myoption)
1020 END SUBROUTINE optionparser_add_sep
1032 SUBROUTINE optionparser_parse(this, nextarg, status)
1034 INTEGER,
INTENT(out) :: nextarg
1035 INTEGER,
INTENT(out) :: status
1037 INTEGER :: i, j, endopt, indeq, iargc
1038 CHARACTER(len=16384) :: arg, optarg
1040 status = optionparser_ok
1042 DO WHILE(i <= iargc())
1044 IF (arg ==
'--')
THEN
1047 ELSE IF (arg ==
'-')
THEN
1049 ELSE IF (arg(1:2) ==
'--')
THEN
1050 indeq =
index(arg,
'=')
1051 IF (indeq /= 0)
THEN
1054 endopt = len_trim(arg)
1056 find_longopt:
DO j = 1, this%options%arraysize
1057 IF (this%options%array(j)%long_opt == arg(3:endopt))
THEN
1058 SELECT CASE(this%options%array(j)%need_arg)
1060 IF (indeq /= 0)
THEN
1061 optarg = arg(indeq+1:)
1062 status = max(option_found(this%options%array(j), optarg), &
1065 IF (i < iargc())
THEN
1067 CALL getarg(i, optarg)
1068 status = max(option_found(this%options%array(j), optarg), &
1071 status = optionparser_err
1072 CALL l4f_log(l4f_error, &
1073 'in optionparser, option '''//trim(arg)//
''' requires an argument')
1077 IF (indeq /= 0)
THEN
1078 optarg = arg(indeq+1:)
1080 IF (i < iargc())
THEN
1081 CALL getarg(i+1, optarg)
1082 IF (optarg(1:1) ==
'-')
THEN
1091 status = max(option_found(this%options%array(j), optarg), &
1094 status = max(option_found(this%options%array(j)), &
1100 IF (j > this%options%arraysize)
THEN
1101 status = optionparser_err
1102 CALL l4f_log(l4f_error, &
1103 'in optionparser, option '''//trim(arg)//
''' not valid')
1105 ELSE IF (arg(1:1) ==
'-')
THEN
1106 find_shortopt:
DO j = 1, this%options%arraysize
1107 IF (this%options%array(j)%short_opt == arg(2:2))
THEN
1108 SELECT CASE(this%options%array(j)%need_arg)
1110 IF (len_trim(arg) > 2)
THEN
1112 status = max(option_found(this%options%array(j), optarg), &
1115 IF (i < iargc())
THEN
1117 CALL getarg(i, optarg)
1118 status = max(option_found(this%options%array(j), optarg), &
1121 status = optionparser_err
1122 CALL l4f_log(l4f_error, &
1123 'in optionparser, option '''//trim(arg)//
''' requires an argument')
1127 IF (len_trim(arg) > 2)
THEN
1130 IF (i < iargc())
THEN
1131 CALL getarg(i+1, optarg)
1132 IF (optarg(1:1) ==
'-')
THEN
1141 status = max(option_found(this%options%array(j), optarg), &
1144 status = max(option_found(this%options%array(j)), &
1150 IF (j > this%options%arraysize)
THEN
1151 status = optionparser_err
1152 CALL l4f_log(l4f_error, &
1153 'in optionparser, option '''//trim(arg)//
''' not valid')
1163 CASE(optionparser_err, optionparser_help)
1164 CALL optionparser_printhelp(this)
1167 END SUBROUTINE optionparser_parse
1173 SUBROUTINE optionparser_printhelp(this)
1179 DO i = 1, this%options%arraysize
1180 IF (this%options%array(i)%opttype == opttype_help)
THEN
1181 form = this%options%array(i)%helpformat
1187 CALL optionparser_printhelptxt(this)
1189 CALL optionparser_printhelpmd(this)
1191 CALL optionparser_printhelphtmlform(this)
1194 END SUBROUTINE optionparser_printhelp
1200 SUBROUTINE optionparser_printhelptxt(this)
1203 INTEGER :: i, j, ncols
1204 CHARACTER(len=80) :: buf
1207 ncols = default_columns()
1210 IF (
ASSOCIATED(this%usage_msg))
THEN
1211 help_line = line_split_new(cstr_to_fchar(this%usage_msg), ncols)
1212 DO j = 1, line_split_get_nlines(help_line)
1213 WRITE(*,
'(A)')trim(line_split_get_line(help_line,j))
1218 i =
index(buf,
'/', back=.true.)
1219 IF (buf(i+1:i+3) ==
'lt-') i = i + 3
1220 WRITE(*,
'(A)')
'Usage: '//trim(buf(i+1:))//
' [options] [arguments]'
1224 IF (
ASSOCIATED(this%description_msg))
THEN
1226 help_line = line_split_new(cstr_to_fchar(this%description_msg), ncols)
1227 DO j = 1, line_split_get_nlines(help_line)
1228 WRITE(*,
'(A)')trim(line_split_get_line(help_line,j))
1233 WRITE(*,
'(/,A)')
'Options:'
1235 DO i = 1, this%options%arraysize
1236 CALL option_format_help(this%options%array(i), ncols)
1239 END SUBROUTINE optionparser_printhelptxt
1245 SUBROUTINE optionparser_printhelpmd(this)
1248 INTEGER :: i, j, ncols
1249 CHARACTER(len=80) :: buf
1252 ncols = default_columns()
1255 WRITE(*,
'(A)')
'### Synopsis'
1257 IF (
ASSOCIATED(this%usage_msg))
THEN
1258 help_line = line_split_new(mdquote_usage_msg(cstr_to_fchar(this%usage_msg)), ncols)
1259 DO j = 1, line_split_get_nlines(help_line)
1260 WRITE(*,
'(A)')trim(line_split_get_line(help_line,j))
1265 i =
index(buf,
'/', back=.true.)
1266 IF (buf(i+1:i+3) ==
'lt-') i = i + 3
1267 WRITE(*,
'(A)')
'Usage: `'//trim(buf(i+1:))//
' [options] [arguments]`'
1271 IF (
ASSOCIATED(this%description_msg))
THEN
1273 WRITE(*,
'(A)')
'### Description'
1274 help_line = line_split_new(cstr_to_fchar(this%description_msg), ncols)
1275 DO j = 1, line_split_get_nlines(help_line)
1276 WRITE(*,
'(A)')trim(line_split_get_line(help_line,j))
1282 WRITE(*,
'(/,A)')
'### Options'
1284 DO i = 1, this%options%arraysize
1285 CALL option_format_md(this%options%array(i), ncols)
1290 FUNCTION mdquote_usage_msg(usage_msg)
1291 CHARACTER(len=*),
INTENT(in) :: usage_msg
1293 CHARACTER(len=LEN(usage_msg)+2) :: mdquote_usage_msg
1296 colon =
index(usage_msg,
':')
1297 IF (colon > 0 .AND. colon < len(usage_msg)-1)
THEN
1298 mdquote_usage_msg = usage_msg(:colon+1)//
'`'//usage_msg(colon+2:)//
'`'
1300 mdquote_usage_msg = usage_msg
1303 END FUNCTION mdquote_usage_msg
1305 END SUBROUTINE optionparser_printhelpmd
1310 SUBROUTINE optionparser_printhelphtmlform(this)
1315 DO i = 1, this%options%arraysize
1316 CALL option_format_htmlform(this%options%array(i))
1319 WRITE(*,
'(A)')
'<input class="libsim_sub" type="submit" value="runprogram" />'
1321 END SUBROUTINE optionparser_printhelphtmlform
1324 SUBROUTINE optionparser_make_completion(this)
1328 CHARACTER(len=512) :: buf
1332 WRITE(*,
'(A/A/A)')
'_'//trim(buf)//
'()',
'{',
'local cur'
1334 WRITE(*,
'(A/A/A/A)')
'COMPREPLY=()',
'cur=${COMP_WORDS[COMP_CWORD]}', &
1335 'case "$cur" in',
'-*)'
1339 DO i = 1, this%options%arraysize
1340 IF (this%options%array(i)%need_arg == 2)
THEN
1344 WRITE(*,
'(A/A/A)')
'esac',
'return 0',
'}'
1346 END SUBROUTINE optionparser_make_completion
1350 SUBROUTINE dirty_char_pointer_set(from, to)
1351 CHARACTER(len=1),
POINTER :: from
1352 CHARACTER(len=1),
TARGET :: to
1354 END SUBROUTINE dirty_char_pointer_set
1359 SUBROUTINE dirty_char_assignment(destc, destclen, src, srclen)
1363 INTEGER(kind=int_b) :: destc(*), src(*)
1364 INTEGER :: destclen, srclen
1368 DO i = 1, min(destclen, srclen)
1371 DO i = srclen+1, destclen
1372 destc(i) = ichar(
' ')
1375 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...