~siesta-pseudos-bases/siesta/trunk-psml

« back to all changes in this revision

Viewing changes to Util/WFS/m_getopts.f90

  • Committer: Alberto Garcia
  • Date: 2019-09-02 14:09:43 UTC
  • mfrom: (427.6.323 trunk)
  • Revision ID: albertog@icmab.es-20190902140943-mzmbe1jacgefpgxw
Sync to trunk-776 (notably nc/soc wavefunction support)


Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
module m_getopts
 
2
use f2kcli
 
3
public :: getopts
 
4
 
 
5
CONTAINS
 
6
 
 
7
subroutine getopts(optionstring,name,optarg,optind,exitcode)
 
8
!$$$  Subprogram Documentation Block
 
9
!
 
10
! Subprogram:  Getopts    Process command line arguments for valid options
 
11
!   Prgmmr: Iredell       Org: W/NP23        Date: 2000-08-22
 
12
!
 
13
! Abstract: This subprogram processes command-line arguments for valid options.
 
14
!           It is the Fortran equivalent of the built-in shell command getopts.
 
15
!           Options on the command line come before the positional arguments.
 
16
!           Options are preceded by a - (minus sign) or a + (plus sign).
 
17
!           Options are single case-sensitive alphanumeric characters.
 
18
!           Options either do or do not have an expected argument.
 
19
!           Options without an argument may be immediately succeeded by
 
20
!           further options without the accompanying - or + prefix.
 
21
!           Options with an argument may be separated from their argument
 
22
!           by zero or more blanks.  The argument cannot end with a blank.
 
23
!           Options end when not preceded by a - or a + or after -- or ++.
 
24
!           This subprogram processes one option per invocation.
 
25
!           This subprogram is not thread-safe.
 
26
!
 
27
! Program History Log:
 
28
!   2007-05-05  Alberto Garcia: Use f2k-compliant f2kcli module
 
29
!   2000-08-22  Iredell
 
30
!
 
31
! Usage:    call getopts(optionstring,name,optarg,optind,exitcode)
 
32
!
 
33
!   Input Argument List:
 
34
!     optionstring
 
35
!       character string containing a list of all valid options;
 
36
!       options succeeded by a : require an argument
 
37
!
 
38
!   Input and Output Argument List:
 
39
!     optind
 
40
!       integer index of the next argument to be processed;
 
41
!       set to 0 before initial call or to restart processing
 
42
!
 
43
!   Output Argument List:
 
44
!     name
 
45
!       character string containing the name of the next option
 
46
!       or ? if no option or an unknown option is found
 
47
!       or : if an option had a missing required argument;
 
48
!       a + is prepended to the value in name if the option begins with a +
 
49
!     optarg
 
50
!       character string containing the option argument if required
 
51
!       or null if not required or not found;
 
52
!       optarg contains the option found if name is ? or :.
 
53
!     exitcode
 
54
!       integer return code (0 if an option was found, 1 if end of options)
 
55
!     
 
56
! Subprograms Called:
 
57
!   command_argument_count
 
58
!     Retrieve number of command-line arguments
 
59
!   get_command_argument
 
60
!     Retrieve a command-line argument
 
61
!   index 
 
62
!     Retrieve the starting position of a substring within a string
 
63
!     
 
64
! Remarks:
 
65
!   Here is an example of how to use this subprogram.
 
66
!     -----------------------------------------------------------
 
67
!     implicit none
 
68
!     character(len=20) copt,carg,cb,cpos
 
69
!     integer ia,ib,iopt,iret,narg,npos,ipos
 
70
!
 
71
!     ia=0     ! Programmer's flag for option a
 
72
!     ib=0     !  "                           b
 
73
!
 
74
!     iopt=0
 
75
!     do
 
76
!       call getopts('ab:',copt,carg,iopt,iret)
 
77
!       if(iret.ne.0) exit
 
78
!       select case(copt)
 
79
!       case('a','+a')
 
80
!         ia=1
 
81
!       case('b','+b')
 
82
!         ib=1
 
83
!         cb=carg
 
84
!       case('?',':')
 
85
!         print *,'invalid option ',carg(1:1)
 
86
!         stop 1
 
87
!       end select
 
88
!     enddo
 
89
!     if(ia.eq.1) print *,'option a selected'
 
90
!     if(ib.eq.1) print *,'option b selected; argument=',cb
 
91
!
 
92
!     Now process positional parameters
 
93
!     narg=command_argument_count()
 
94
!     npos=narg-iopt+1
 
95
!     do ipos=1,npos
 
96
!       call get_command_argument(number=ipos+iopt-1,value=cpos)
 
97
!       print *,'positional argument ',ipos,' is ',cpos
 
98
!     enddo
 
99
!     end
 
100
!     -----------------------------------------------------------
 
101
!
 
102
! Attributes:
 
103
!   Language: Fortran 90
 
104
!
 
105
!$$$
 
106
  implicit none
 
107
 
 
108
!  Passed data
 
109
  character(len=*),intent(in)      :: optionstring
 
110
  character(len=*),intent(out)     :: name
 
111
  character(len=*),intent(out)     :: optarg
 
112
  integer,         intent(inout)   :: optind
 
113
  integer,         intent(out)     :: exitcode
 
114
 
 
115
!  Saved data
 
116
  character(len=256), save  :: carg
 
117
  character(len=1) ,  save  :: cone
 
118
  integer,save              :: narg,larg,lcur
 
119
 
 
120
!  Local data
 
121
  character(len=1) ::  copt
 
122
  integer          ::  lname,lopt
 
123
 
 
124
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
125
!  Initially set saved data.
 
126
  if(optind.le.0) then
 
127
    optind=0
 
128
    narg=command_argument_count()
 
129
    carg=''
 
130
    cone=''
 
131
    larg=0
 
132
    lcur=1
 
133
  endif
 
134
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
135
!  Retrieve next command-line argument if necessary;
 
136
!  exit if at end of options
 
137
  if(lcur.gt.larg) then
 
138
    optind=optind+1
 
139
    if(optind.gt.narg) then
 
140
      name='?'
 
141
      optarg=''
 
142
      exitcode=1
 
143
      RETURN
 
144
    endif
 
145
    call get_command_argument(number=optind,value=carg)
 
146
    cone=carg(1:1)
 
147
    larg=len_trim(carg)
 
148
    lcur=2
 
149
    if(larg.eq.1.or.(cone.ne.'-'.and.cone.ne.'+')) then
 
150
      name='?'
 
151
      optarg=''
 
152
      exitcode=1
 
153
      RETURN
 
154
    elseif(larg.eq.2.and.carg(2:2).eq.cone) then
 
155
      optind=optind+1
 
156
      name='?'
 
157
      optarg=''
 
158
      exitcode=1
 
159
      RETURN
 
160
    endif
 
161
  endif
 
162
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
163
!  Find next option in the list; exit if option is unknown
 
164
  exitcode=0
 
165
  copt=carg(lcur:lcur)
 
166
  lcur=lcur+1
 
167
  lopt=index(optionstring,copt)
 
168
  if(lopt.eq.0) then
 
169
    name='?'
 
170
    optarg=copt
 
171
    RETURN
 
172
  endif
 
173
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
174
!  Option found; retrieve its argument if requested
 
175
    if(cone.eq.'-') then
 
176
      name=""
 
177
      lname=1
 
178
    else
 
179
      name="+"
 
180
      lname=2
 
181
    endif
 
182
  name(lname:lname)=copt
 
183
  optarg=''
 
184
  if(lopt.lt.len(optionstring)) then
 
185
     if (optionstring(lopt+1:lopt+1).eq.':') then
 
186
        if(lcur.gt.larg) then
 
187
           optind=optind+1
 
188
           if(optind.gt.narg) then
 
189
              name=':'
 
190
              optarg=copt
 
191
              RETURN
 
192
           endif
 
193
           call get_command_argument(number=optind,value=carg)
 
194
           larg=len_trim(carg)
 
195
           lcur=1
 
196
        endif
 
197
        optarg=carg(lcur:larg)
 
198
        lcur=larg+1
 
199
     endif
 
200
  endif
 
201
end subroutine
 
202
end module m_getopts