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()
47 TYPE(arrayof_integer),
POINTER :: destiarr=>null()
48 REAL,
POINTER :: destr=>null()
49 TYPE(arrayof_real),
POINTER :: destrarr=>null()
50 DOUBLE PRECISION,
POINTER :: destd=>null()
51 TYPE(arrayof_doubleprecision),
POINTER :: destdarr=>null()
52 LOGICAL,
POINTER :: destl=>null()
53 TYPE(arrayof_logical),
POINTER :: destlarr=>null()
54 INTEGER,
POINTER :: destcount=>null()
55 INTEGER(kind=int_b),
ALLOCATABLE :: help_msg(:)
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
177INTEGER,
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
182INTEGER,
PARAMETER :: optionparser_ok = 0
183INTEGER,
PARAMETER :: optionparser_help = 1
184INTEGER,
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"
199FUNCTION option_new(short_opt, long_opt, default, help)
RESULT(this)
200CHARACTER(len=*),
INTENT(in) :: short_opt
201CHARACTER(len=*),
INTENT(in) :: long_opt
202CHARACTER(len=*),
INTENT(in) :: default
203CHARACTER(len=*),
OPTIONAL :: help
206IF (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')
217this%short_opt = short_opt
218this%long_opt = long_opt
219IF (
PRESENT(help))
THEN
220 this%help_msg = fchar_to_cstr(trim(help)//trim(default))
222this%has_default = (len_trim(default) > 0)
224END FUNCTION option_new
229SUBROUTINE option_delete(this)
230TYPE(option),
INTENT(inout) :: this
232IF (
ALLOCATED(this%help_msg))
DEALLOCATE(this%help_msg)
238NULLIFY(this%destcount)
240END SUBROUTINE option_delete
243FUNCTION option_found(this, optarg)
RESULT(status)
244TYPE(option),
INTENT(inout) :: this
245CHARACTER(len=*),
INTENT(in),
OPTIONAL :: optarg
248TYPE(csv_record) :: arrparser
251DOUBLE PRECISION :: dbuff
253status = optionparser_ok
255SELECT 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')
312100 status = optionparser_err
313CALL l4f_log(l4f_error, &
314 'in optionparser, argument '''//trim(optarg)//
''' not valid as integer')
316102 status = optionparser_err
317CALL l4f_log(l4f_error, &
318 'in optionparser, argument '''//trim(optarg)//
''' not valid as real')
321END FUNCTION option_found
328FUNCTION option_format_opt(this)
RESULT(format_opt)
329TYPE(option),
INTENT(in) :: this
331CHARACTER(len=100) :: format_opt
333CHARACTER(len=20) :: argname
335SELECT CASE(this%opttype)
341 argname =
'INT[,INT...]'
342CASE(opttype_r, opttype_d)
344CASE(opttype_rarr, opttype_darr)
345 argname =
'REAL[,REAL...]'
351IF (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)
357IF (this%short_opt /=
'' .AND. this%long_opt /=
'')
THEN
358 format_opt(len_trim(format_opt)+1:) =
','
360IF (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)
367END FUNCTION option_format_opt
371SUBROUTINE option_format_help(this, ncols)
372TYPE(option),
INTENT(in) :: this
373INTEGER,
INTENT(in) :: ncols
376INTEGER,
PARAMETER :: indent = 10
377TYPE(line_split) :: help_line
380IF (this%opttype == opttype_sep)
THEN
381 IF (
ALLOCATED(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 (
ALLOCATED(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))
406END SUBROUTINE option_format_help
410SUBROUTINE option_format_md(this, ncols)
411TYPE(option),
INTENT(in) :: this
412INTEGER,
INTENT(in) :: ncols
415INTEGER,
PARAMETER :: indent = 2
416TYPE(line_split) :: help_line
418IF (this%opttype == opttype_sep)
THEN
419 IF (
ALLOCATED(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 (
ALLOCATED(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))
442END SUBROUTINE option_format_md
446SUBROUTINE option_format_htmlform(this)
447TYPE(option),
INTENT(in) :: this
449CHARACTER(len=80) :: opt_name, opt_id, opt_default
451IF (.NOT.c_e(this))
RETURN
452IF (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
460SELECT 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()
473CASE(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()
507SUBROUTINE option_format_html_openspan(formtype)
508CHARACTER(len=*),
INTENT(in) :: formtype
510WRITE(*,
'(A)')
'<span class="libsim_optbox" id="span_'//trim(opt_id)//
'">'//trim(opt_name)//
':'
512WRITE(*,
'(A)')
'<input class_"libsim_opt" id="'//trim(opt_id)//
'" type="'//formtype// &
513 '" name="'//trim(opt_id)//
'" '
515END SUBROUTINE option_format_html_openspan
517SUBROUTINE option_format_html_closespan()
519WRITE(*,
'(A)')
'/></span>'
521END SUBROUTINE option_format_html_closespan
523SUBROUTINE option_format_html_help()
526CHARACTER(len=20) :: form
528IF (
ALLOCATED(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))
540END SUBROUTINE option_format_html_help
542END SUBROUTINE option_format_htmlform
545FUNCTION option_c_e(this)
RESULT(c_e)
546TYPE(option),
INTENT(in) :: this
550c_e = this%long_opt /=
' ' .OR. this%short_opt /=
' '
552END FUNCTION option_c_e
558FUNCTION optionparser_new(usage_msg, description_msg)
RESULT(this)
559CHARACTER(len=*),
INTENT(in),
OPTIONAL :: usage_msg
560CHARACTER(len=*),
INTENT(in),
OPTIONAL :: description_msg
564IF (
PRESENT(usage_msg))
THEN
565 CALL fchar_to_cstr_alloc(trim(usage_msg), this%usage_msg)
567 NULLIFY(this%usage_msg)
569IF (
PRESENT(description_msg))
THEN
570 CALL fchar_to_cstr_alloc(trim(description_msg), this%description_msg)
572 NULLIFY(this%description_msg)
575END FUNCTION optionparser_new
578SUBROUTINE optionparser_delete(this)
581IF (
ASSOCIATED(this%usage_msg))
DEALLOCATE(this%usage_msg)
582IF (
ASSOCIATED(this%description_msg))
DEALLOCATE(this%description_msg)
585END SUBROUTINE optionparser_delete
595SUBROUTINE optionparser_add_c(this, short_opt, long_opt, dest, default, help, isopt)
597CHARACTER(len=*),
INTENT(in) :: short_opt
598CHARACTER(len=*),
INTENT(in) :: long_opt
599CHARACTER(len=*),
TARGET :: dest
600CHARACTER(len=*),
OPTIONAL :: default
601CHARACTER(len=*),
OPTIONAL :: help
602LOGICAL,
INTENT(in),
OPTIONAL :: isopt
604CHARACTER(LEN=60) :: cdefault
606TYPE(option) :: myoption
609IF (
PRESENT(default))
THEN
610 cdefault =
' [default='//
t2c(default,
'MISSING')//
']'
616myoption = option_new(short_opt, long_opt, cdefault, help)
617IF (.NOT.c_e(myoption))
RETURN
619myoption%destc => dest(1:1)
620myoption%destclen = len(dest)
621IF (
PRESENT(default)) &
622 CALL dirty_char_assignment(myoption%destc, myoption%destclen, default)
624myoption%opttype = opttype_c
625IF (optio_log(isopt))
THEN
626 myoption%need_arg = 1
628 myoption%need_arg = 2
631i = arrayof_option_append(this%options, myoption)
633END SUBROUTINE optionparser_add_c
642SUBROUTINE optionparser_add_i(this, short_opt, long_opt, dest, default, help)
644CHARACTER(len=*),
INTENT(in) :: short_opt
645CHARACTER(len=*),
INTENT(in) :: long_opt
646INTEGER,
TARGET :: dest
647INTEGER,
OPTIONAL :: default
648CHARACTER(len=*),
OPTIONAL :: help
650CHARACTER(LEN=40) :: cdefault
652TYPE(option) :: myoption
654IF (
PRESENT(default))
THEN
655 cdefault =
' [default='//
t2c(default,
'MISSING')//
']'
661myoption = option_new(short_opt, long_opt, cdefault, help)
662IF (.NOT.c_e(myoption))
RETURN
664myoption%desti => dest
665IF (
PRESENT(default)) myoption%desti = default
666myoption%opttype = opttype_i
669i = arrayof_option_append(this%options, myoption)
671END SUBROUTINE optionparser_add_i
683SUBROUTINE optionparser_add_iarray(this, short_opt, long_opt, dest, default, help)
685CHARACTER(len=*),
INTENT(in) :: short_opt
686CHARACTER(len=*),
INTENT(in) :: long_opt
688INTEGER,
OPTIONAL :: default(:)
689CHARACTER(len=*),
OPTIONAL :: help
691CHARACTER(LEN=40) :: cdefault
693TYPE(option) :: myoption
696IF (
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)))//
',...]'
705myoption = option_new(short_opt, long_opt, cdefault, help)
706IF (.NOT.c_e(myoption))
RETURN
708myoption%destiarr => dest
709IF (
PRESENT(default))
THEN
710 CALL insert(myoption%destiarr, default)
711 CALL packarray(myoption%destiarr)
713myoption%opttype = opttype_iarr
716i = arrayof_option_append(this%options, myoption)
718END SUBROUTINE optionparser_add_iarray
727SUBROUTINE optionparser_add_r(this, short_opt, long_opt, dest, default, help)
729CHARACTER(len=*),
INTENT(in) :: short_opt
730CHARACTER(len=*),
INTENT(in) :: long_opt
732REAL,
OPTIONAL :: default
733CHARACTER(len=*),
OPTIONAL :: help
735CHARACTER(LEN=40) :: cdefault
737TYPE(option) :: myoption
739IF (
PRESENT(default))
THEN
740 cdefault =
' [default='//
t2c(default,
'MISSING')//
']'
746myoption = option_new(short_opt, long_opt, cdefault, help)
747IF (.NOT.c_e(myoption))
RETURN
749myoption%destr => dest
750IF (
PRESENT(default)) myoption%destr = default
751myoption%opttype = opttype_r
754i = arrayof_option_append(this%options, myoption)
756END SUBROUTINE optionparser_add_r
768SUBROUTINE optionparser_add_rarray(this, short_opt, long_opt, dest, default, help)
770CHARACTER(len=*),
INTENT(in) :: short_opt
771CHARACTER(len=*),
INTENT(in) :: long_opt
773REAL,
OPTIONAL :: default(:)
774CHARACTER(len=*),
OPTIONAL :: help
776CHARACTER(LEN=40) :: cdefault
778TYPE(option) :: myoption
781IF (
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)))//
',...]'
790myoption = option_new(short_opt, long_opt, cdefault, help)
791IF (.NOT.c_e(myoption))
RETURN
793myoption%destrarr => dest
794IF (
PRESENT(default))
THEN
795 CALL insert(myoption%destrarr, default)
796 CALL packarray(myoption%destrarr)
798myoption%opttype = opttype_rarr
801i = arrayof_option_append(this%options, myoption)
803END SUBROUTINE optionparser_add_rarray
812SUBROUTINE optionparser_add_d(this, short_opt, long_opt, dest, default, help)
814CHARACTER(len=*),
INTENT(in) :: short_opt
815CHARACTER(len=*),
INTENT(in) :: long_opt
816DOUBLE PRECISION,
TARGET :: dest
817DOUBLE PRECISION,
OPTIONAL :: default
818CHARACTER(len=*),
OPTIONAL :: help
820CHARACTER(LEN=40) :: cdefault
822TYPE(option) :: myoption
824IF (
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')//
']'
835myoption = option_new(short_opt, long_opt, cdefault, help)
836IF (.NOT.c_e(myoption))
RETURN
838myoption%destd => dest
839IF (
PRESENT(default)) myoption%destd = default
840myoption%opttype = opttype_d
843i = arrayof_option_append(this%options, myoption)
845END SUBROUTINE optionparser_add_d
857SUBROUTINE optionparser_add_darray(this, short_opt, long_opt, dest, default, help)
859CHARACTER(len=*),
INTENT(in) :: short_opt
860CHARACTER(len=*),
INTENT(in) :: long_opt
862DOUBLE PRECISION,
OPTIONAL :: default(:)
863CHARACTER(len=*),
OPTIONAL :: help
865CHARACTER(LEN=40) :: cdefault
867TYPE(option) :: myoption
870IF (
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)')))//
',...]'
879myoption = option_new(short_opt, long_opt, cdefault, help)
880IF (.NOT.c_e(myoption))
RETURN
882myoption%destdarr => dest
883IF (
PRESENT(default))
THEN
884 CALL insert(myoption%destdarr, default)
885 CALL packarray(myoption%destdarr)
887myoption%opttype = opttype_darr
890i = arrayof_option_append(this%options, myoption)
892END SUBROUTINE optionparser_add_darray
901SUBROUTINE optionparser_add_l(this, short_opt, long_opt, dest, help)
903CHARACTER(len=*),
INTENT(in) :: short_opt
904CHARACTER(len=*),
INTENT(in) :: long_opt
905LOGICAL,
TARGET :: dest
906CHARACTER(len=*),
OPTIONAL :: help
909TYPE(option) :: myoption
912myoption = option_new(short_opt, long_opt,
'', help)
913IF (.NOT.c_e(myoption))
RETURN
915myoption%destl => dest
916myoption%destl = .false.
917myoption%opttype = opttype_l
920i = arrayof_option_append(this%options, myoption)
922END SUBROUTINE optionparser_add_l
929SUBROUTINE optionparser_add_count(this, short_opt, long_opt, dest, start, help)
931CHARACTER(len=*),
INTENT(in) :: short_opt
932CHARACTER(len=*),
INTENT(in) :: long_opt
933INTEGER,
TARGET :: dest
934INTEGER,
OPTIONAL :: start
935CHARACTER(len=*),
OPTIONAL :: help
938TYPE(option) :: myoption
941myoption = option_new(short_opt, long_opt,
'', help)
942IF (.NOT.c_e(myoption))
RETURN
944myoption%destcount => dest
945IF (
PRESENT(start)) myoption%destcount = start
946myoption%opttype = opttype_count
949i = arrayof_option_append(this%options, myoption)
951END SUBROUTINE optionparser_add_count
968SUBROUTINE optionparser_add_help(this, short_opt, long_opt, help)
970CHARACTER(len=*),
INTENT(in) :: short_opt
971CHARACTER(len=*),
INTENT(in) :: long_opt
972CHARACTER(len=*),
OPTIONAL :: help
975TYPE(option) :: myoption
978myoption = option_new(short_opt, long_opt,
'', help)
979IF (.NOT.c_e(myoption))
RETURN
981myoption%opttype = opttype_help
984i = arrayof_option_append(this%options, myoption)
986END SUBROUTINE optionparser_add_help
999SUBROUTINE optionparser_add_sep(this, help)
1003CHARACTER(len=*) :: help
1006TYPE(option) :: myoption
1009myoption = option_new(
'_',
'_',
'', help)
1010IF (.NOT.c_e(myoption))
RETURN
1012myoption%opttype = opttype_sep
1013myoption%need_arg = 0
1015i = arrayof_option_append(this%options, myoption)
1017END SUBROUTINE optionparser_add_sep
1029SUBROUTINE optionparser_parse(this, nextarg, status)
1031INTEGER,
INTENT(out) :: nextarg
1032INTEGER,
INTENT(out) :: status
1034INTEGER :: i, j, endopt, indeq, iargc
1035CHARACTER(len=16384) :: arg, optarg
1037status = optionparser_ok
1039DO 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')
1160CASE(optionparser_err, optionparser_help)
1161 CALL optionparser_printhelp(this)
1164END SUBROUTINE optionparser_parse
1170SUBROUTINE optionparser_printhelp(this)
1176DO 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)
1191END SUBROUTINE optionparser_printhelp
1197SUBROUTINE optionparser_printhelptxt(this)
1200INTEGER :: i, j, ncols
1201CHARACTER(len=80) :: buf
1204ncols = default_columns()
1207IF (
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]'
1221IF (
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))
1230WRITE(*,
'(/,A)')
'Options:'
1232DO i = 1, this%options%arraysize
1233 CALL option_format_help(this%options%array(i), ncols)
1236END SUBROUTINE optionparser_printhelptxt
1242SUBROUTINE optionparser_printhelpmd(this)
1245INTEGER :: i, j, ncols
1246CHARACTER(len=80) :: buf
1249ncols = default_columns()
1252WRITE(*,
'(A)')
'### Synopsis'
1254IF (
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))
1262 i =
index(buf,
'/', back=.true.)
1263 IF (buf(i+1:i+3) ==
'lt-') i = i + 3
1264 WRITE(*,
'(A)')
'Usage: `'//trim(buf(i+1:))//
' [options] [arguments]`'
1268IF (
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))
1279WRITE(*,
'(/,A)')
'### Options'
1281DO i = 1, this%options%arraysize
1282 CALL option_format_md(this%options%array(i), ncols)
1287FUNCTION mdquote_usage_msg(usage_msg)
1288CHARACTER(len=*),
INTENT(in) :: usage_msg
1290CHARACTER(len=LEN(usage_msg)+2) :: mdquote_usage_msg
1293colon =
index(usage_msg,
':')
1294IF (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
1300END FUNCTION mdquote_usage_msg
1302END SUBROUTINE optionparser_printhelpmd
1307SUBROUTINE optionparser_printhelphtmlform(this)
1312DO i = 1, this%options%arraysize
1313 CALL option_format_htmlform(this%options%array(i))
1316WRITE(*,
'(A)')
'<input class="libsim_sub" type="submit" value="runprogram" />'
1318END SUBROUTINE optionparser_printhelphtmlform
1321SUBROUTINE optionparser_make_completion(this)
1325CHARACTER(len=512) :: buf
1329WRITE(*,
'(A/A/A)')
'_'//trim(buf)//
'()',
'{',
'local cur'
1331WRITE(*,
'(A/A/A/A)')
'COMPREPLY=()',
'cur=${COMP_WORDS[COMP_CWORD]}', &
1332 'case "$cur" in',
'-*)'
1336DO i = 1, this%options%arraysize
1337 IF (this%options%array(i)%need_arg == 2)
THEN
1341WRITE(*,
'(A/A/A)')
'esac',
'return 0',
'}'
1343END SUBROUTINE optionparser_make_completion
1346SUBROUTINE dirty_char_assignment(destc, destclen, src)
1350CHARACTER(len=1) :: destc(*)
1351CHARACTER(len=*) :: src
1356DO i = 1, min(destclen, len(src))
1359DO i = len(src)+1, destclen
1363END SUBROUTINE dirty_char_assignment
Set of functions that return a trimmed CHARACTER representation of the input variable.
Set of functions that return a CHARACTER representation of the input variable.
Methods for successively obtaining the fields of a csv_record object.
Constructor for the class csv_record.
Destructor for the optionparser class.
Add a new option of a specific type.
This module defines usefull general purpose function and subroutine.
Utilities for CHARACTER variables.
Utilities for managing files.
Definition of constants to be used for declaring variables of a desired type.
classe per la gestione del logging
Module for parsing command-line optons.
Derived type defining a dynamically extensible array of DOUBLEPRECISION elements.
Derived type defining a dynamically extensible array of INTEGER elements.
Derived type defining a dynamically extensible array of REAL elements.
Class that allows splitting a long line into shorter lines of equal length at the occurrence of a spe...
Class for interpreting the records of a csv file.
This class allows to parse the command-line options of a program in an object-oriented way,...