forked from haniibrahim/f90getopt
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathf90getopt.F90
191 lines (163 loc) · 6.57 KB
/
f90getopt.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
module f90getopt
implicit none
! Portable declaration of stderr, stdin, stdout
#ifdef f2003
use, intrinsic :: iso_fortran_env, only : stdin=>input_unit, &
stdout=>output_unit, &
stderr=>error_unit
#else
#define stdin 5
#define stdout 6
#define stderr 0
#endif
character(len=80):: optarg ! Option's value
character :: optopt ! Option's character
integer :: optind=1 ! Index of the next argument to process
logical :: opterr=.true. ! Errors are printed by default. Set opterr=.false. to suppress them
type option_s
character(len=80) :: name ! Name of the option
logical :: has_arg ! Option has an argument (.true./.false.)
character :: short ! Option's short character equal to optopt
end type option_s
! grpind is index of next option within group; always >= 2
integer, private:: grpind=2
contains
! ----------------------------------------
! Return str(i:j) if 1 <= i <= j <= len(str),
! else return empty string.
! This is needed because Fortran standard allows but doesn't *require* short-circuited
! logical AND and OR operators. So this sometimes fails:
! if ( i < len(str) .and. str(i+1:i+1) == ':' ) then
! but this works:
! if ( substr(str, i+1, i+1) == ':' ) then
character function substr( str, i, j )
! arguments
character(len=*), intent(in):: str
integer, intent(in):: i, j
if ( 1 <= i .and. i <= j .and. j <= len(str)) then
substr = str(i:j)
else
substr = ''
endif
end function substr
! ----------------------------------------
character function getopt( optstring, longopts )
! arguments
character(len=*), intent(in):: optstring
type(option_s), intent(in), optional:: longopts(:)
! local variables
character(len=80):: arg
optarg = ''
if ( optind > command_argument_count()) then
getopt = char(0)
endif
call get_command_argument( optind, arg )
if ( present( longopts ) .and. arg(1:2) == '--' ) then
getopt = process_long( longopts, arg )
elseif ( arg(1:1) == '-' ) then
getopt = process_short( optstring, arg )
else
getopt = char(0)
endif
end function getopt
! ----------------------------------------
character function process_long( longopts, arg )
! arguments
type(option_s), intent(in):: longopts(:)
character(len=*), intent(in):: arg
! local variables
integer :: i = 0
integer :: j = 0
integer :: len_arg = 0 ! length of arg
logical :: has_equalsign = .false. ! arg contains equal sign?
len_arg = len_trim(arg)
! search for equal sign in arg and set flag "has_equalsign" and
! length of arg (till equal sign)
do j=1, len_arg
if (arg(j:j) == "=") then
has_equalsign = .true.
len_arg = j-1
exit
endif
enddo
! search for matching long option
if (.not. has_equalsign) then
optind = optind + 1
endif
do i = 1, size(longopts)
if ( arg(3:len_arg) == longopts(i)%name ) then
optopt = longopts(i)%short
process_long = optopt
if ( longopts(i)%has_arg ) then
if (has_equalsign) then ! long option has equal sign between value and option
if (arg(len_arg+2:) == '') then ! no value (len_arg+2 value after "="
write(stderr, '(a,a,a)') "ERROR: Option '", trim(arg), "' requires a value"
process_long=char(0) ! Option not valid
else
call get_command_argument(optind, optarg)
optarg = optarg(len_arg+2:)
optind = optind + 1
endif
else ! long option has no equal sign between value and option
if ( optind <= command_argument_count()) then
call get_command_argument( optind, optarg )
optind = optind + 1
elseif ( opterr ) then
write(stderr, '(a,a,a)') "ERROR: Option '", trim(arg), "' requires a value"
process_long=char(0) ! Option not valid
endif
endif
endif
return
endif
end do
! else not found
process_long = char(0)
optopt='?'
if ( opterr ) then
write(stderr, '(a,a,a)') "ERROR: Unrecognized option '", arg(1:len_arg), "'"
endif
return
end function process_long
! ----------------------------------------
character function process_short( optstring, arg )
! arguments
character(len=*), intent(in):: optstring, arg
! local variables
integer:: i, arglen
arglen = len( trim( arg ))
optopt = arg(grpind:grpind)
process_short = optopt
i = index( optstring, optopt )
if ( i == 0 ) then
! unrecognized option
process_short = '?'
if ( opterr ) then
write(stderr, '(a,a,a)') "ERROR: Unrecognized option '-", optopt, "'"
endif
endif
if ( i > 0 .and. substr( optstring, i+1, i+1 ) == ':' ) then
! required argument
optind = optind + 1
if ( arglen > grpind ) then
! -xarg, return remainder of arg
optarg = arg(grpind+1:arglen)
elseif ( optind <= command_argument_count()) then
! -x arg, return next arg
call get_command_argument( optind, optarg )
optind = optind + 1
elseif ( opterr ) then
write(stderr, '(a,a,a)') "ERROR: Option '-", optopt, "' requires a value"
process_short = char(0) ! Option not valid
endif
grpind = 2
elseif ( arglen > grpind ) then
! no argument (or unrecognized), go to next option in argument (-xyz)
grpind = grpind + 1
else
! no argument (or unrecognized), go to next argument
grpind = 2
optind = optind + 1
endif
end function process_short
end module f90getopt