6
subroutine getopts(optionstring,name,optarg,optind,exitcode)
7
!$$$ Subprogram Documentation Block
9
! Subprogram: Getopts Process command line arguments for valid options
10
! Prgmmr: Iredell Org: W/NP23 Date: 2000-08-22
12
! Abstract: This subprogram processes command-line arguments for valid options.
13
! It is the Fortran equivalent of the built-in shell command getopts.
14
! Options on the command line come before the positional arguments.
15
! Options are preceded by a - (minus sign) or a + (plus sign).
16
! Options are single case-sensitive alphanumeric characters.
17
! Options either do or do not have an expected argument.
18
! Options without an argument may be immediately succeeded by
19
! further options without the accompanying - or + prefix.
20
! Options with an argument may be separated from their argument
21
! by zero or more blanks. The argument cannot end with a blank.
22
! Options end when not preceded by a - or a + or after -- or ++.
23
! This subprogram processes one option per invocation.
24
! This subprogram is not thread-safe.
26
! Program History Log:
27
! 2007-05-05 Alberto Garcia: Use f2k-compliant f2kcli module
30
! Usage: call getopts(optionstring,name,optarg,optind,exitcode)
32
! Input Argument List:
34
! character string containing a list of all valid options;
35
! options succeeded by a : require an argument
37
! Input and Output Argument List:
39
! integer index of the next argument to be processed;
40
! set to 0 before initial call or to restart processing
42
! Output Argument List:
44
! character string containing the name of the next option
45
! or ? if no option or an unknown option is found
46
! or : if an option had a missing required argument;
47
! a + is prepended to the value in name if the option begins with a +
49
! character string containing the option argument if required
50
! or null if not required or not found;
51
! optarg contains the option found if name is ? or :.
53
! integer return code (0 if an option was found, 1 if end of options)
56
! command_argument_count
57
! Retrieve number of command-line arguments
58
! get_command_argument
59
! Retrieve a command-line argument
61
! Retrieve the starting position of a substring within a string
64
! Here is an example of how to use this subprogram.
65
! -----------------------------------------------------------
67
! character(len=20) copt,carg,cb,cpos
68
! integer ia,ib,iopt,iret,narg,npos,ipos
70
! ia=0 ! Programmer's flag for option a
75
! call getopts('ab:',copt,carg,iopt,iret)
84
! print *,'invalid option ',carg(1:1)
88
! if(ia.eq.1) print *,'option a selected'
89
! if(ib.eq.1) print *,'option b selected; argument=',cb
91
! Now process positional parameters
92
! narg=command_argument_count()
95
! call get_command_argument(number=ipos+iopt-1,value=cpos)
96
! print *,'positional argument ',ipos,' is ',cpos
99
! -----------------------------------------------------------
102
! Language: Fortran 90
108
character(len=*),intent(in) :: optionstring
109
character(len=*),intent(out) :: name
110
character(len=*),intent(out) :: optarg
111
integer, intent(inout) :: optind
112
integer, intent(out) :: exitcode
115
character(len=256), save :: carg
116
character(len=1) , save :: cone
117
integer,save :: narg,larg,lcur
120
character(len=1) :: copt
121
integer :: lname,lopt
123
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
124
! Initially set saved data.
127
narg=command_argument_count()
133
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
134
! Retrieve next command-line argument if necessary;
135
! exit if at end of options
136
if(lcur.gt.larg) then
138
if(optind.gt.narg) then
144
call get_command_argument(number=optind,value=carg)
148
if(larg.eq.1.or.(cone.ne.'-'.and.cone.ne.'+')) then
153
elseif(larg.eq.2.and.carg(2:2).eq.cone) then
161
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
162
! Find next option in the list; exit if option is unknown
166
lopt=index(optionstring,copt)
172
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
173
! Option found; retrieve its argument if requested
181
name(lname:lname)=copt
183
if(lopt.lt.len(optionstring)) then
184
if (optionstring(lopt+1:lopt+1).eq.':') then
185
if(lcur.gt.larg) then
187
if(optind.gt.narg) then
192
call get_command_argument(number=optind,value=carg)
196
optarg=carg(lcur:larg)