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

« back to all changes in this revision

Viewing changes to Util/STM/simple-stm/options.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
public :: getopts
 
3
 
 
4
CONTAINS
 
5
 
 
6
subroutine getopts(optionstring,name,optarg,optind,exitcode)
 
7
!$$$  Subprogram Documentation Block
 
8
!
 
9
! Subprogram:  Getopts    Process command line arguments for valid options
 
10
!   Prgmmr: Iredell       Org: W/NP23        Date: 2000-08-22
 
11
!
 
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.
 
25
!
 
26
! Program History Log:
 
27
!   2007-05-05  Alberto Garcia: Use f2k-compliant f2kcli module
 
28
!   2000-08-22  Iredell
 
29
!
 
30
! Usage:    call getopts(optionstring,name,optarg,optind,exitcode)
 
31
!
 
32
!   Input Argument List:
 
33
!     optionstring
 
34
!       character string containing a list of all valid options;
 
35
!       options succeeded by a : require an argument
 
36
!
 
37
!   Input and Output Argument List:
 
38
!     optind
 
39
!       integer index of the next argument to be processed;
 
40
!       set to 0 before initial call or to restart processing
 
41
!
 
42
!   Output Argument List:
 
43
!     name
 
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 +
 
48
!     optarg
 
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 :.
 
52
!     exitcode
 
53
!       integer return code (0 if an option was found, 1 if end of options)
 
54
!     
 
55
! Subprograms Called:
 
56
!   command_argument_count
 
57
!     Retrieve number of command-line arguments
 
58
!   get_command_argument
 
59
!     Retrieve a command-line argument
 
60
!   index 
 
61
!     Retrieve the starting position of a substring within a string
 
62
!     
 
63
! Remarks:
 
64
!   Here is an example of how to use this subprogram.
 
65
!     -----------------------------------------------------------
 
66
!     implicit none
 
67
!     character(len=20) copt,carg,cb,cpos
 
68
!     integer ia,ib,iopt,iret,narg,npos,ipos
 
69
!
 
70
!     ia=0     ! Programmer's flag for option a
 
71
!     ib=0     !  "                           b
 
72
!
 
73
!     iopt=0
 
74
!     do
 
75
!       call getopts('ab:',copt,carg,iopt,iret)
 
76
!       if(iret.ne.0) exit
 
77
!       select case(copt)
 
78
!       case('a','+a')
 
79
!         ia=1
 
80
!       case('b','+b')
 
81
!         ib=1
 
82
!         cb=carg
 
83
!       case('?',':')
 
84
!         print *,'invalid option ',carg(1:1)
 
85
!         stop 1
 
86
!       end select
 
87
!     enddo
 
88
!     if(ia.eq.1) print *,'option a selected'
 
89
!     if(ib.eq.1) print *,'option b selected; argument=',cb
 
90
!
 
91
!     Now process positional parameters
 
92
!     narg=command_argument_count()
 
93
!     npos=narg-iopt+1
 
94
!     do ipos=1,npos
 
95
!       call get_command_argument(number=ipos+iopt-1,value=cpos)
 
96
!       print *,'positional argument ',ipos,' is ',cpos
 
97
!     enddo
 
98
!     end
 
99
!     -----------------------------------------------------------
 
100
!
 
101
! Attributes:
 
102
!   Language: Fortran 90
 
103
!
 
104
!$$$
 
105
  implicit none
 
106
 
 
107
!  Passed data
 
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
 
113
 
 
114
!  Saved data
 
115
  character(len=256), save  :: carg
 
116
  character(len=1) ,  save  :: cone
 
117
  integer,save              :: narg,larg,lcur
 
118
 
 
119
!  Local data
 
120
  character(len=1) ::  copt
 
121
  integer          ::  lname,lopt
 
122
 
 
123
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
124
!  Initially set saved data.
 
125
  if(optind.le.0) then
 
126
    optind=0
 
127
    narg=command_argument_count()
 
128
    carg=''
 
129
    cone=''
 
130
    larg=0
 
131
    lcur=1
 
132
  endif
 
133
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
134
!  Retrieve next command-line argument if necessary;
 
135
!  exit if at end of options
 
136
  if(lcur.gt.larg) then
 
137
    optind=optind+1
 
138
    if(optind.gt.narg) then
 
139
      name='?'
 
140
      optarg=''
 
141
      exitcode=1
 
142
      RETURN
 
143
    endif
 
144
    call get_command_argument(number=optind,value=carg)
 
145
    cone=carg(1:1)
 
146
    larg=len_trim(carg)
 
147
    lcur=2
 
148
    if(larg.eq.1.or.(cone.ne.'-'.and.cone.ne.'+')) then
 
149
      name='?'
 
150
      optarg=''
 
151
      exitcode=1
 
152
      RETURN
 
153
    elseif(larg.eq.2.and.carg(2:2).eq.cone) then
 
154
      optind=optind+1
 
155
      name='?'
 
156
      optarg=''
 
157
      exitcode=1
 
158
      RETURN
 
159
    endif
 
160
  endif
 
161
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
162
!  Find next option in the list; exit if option is unknown
 
163
  exitcode=0
 
164
  copt=carg(lcur:lcur)
 
165
  lcur=lcur+1
 
166
  lopt=index(optionstring,copt)
 
167
  if(lopt.eq.0) then
 
168
    name='?'
 
169
    optarg=copt
 
170
    RETURN
 
171
  endif
 
172
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
173
!  Option found; retrieve its argument if requested
 
174
    if(cone.eq.'-') then
 
175
      name=""
 
176
      lname=1
 
177
    else
 
178
      name="+"
 
179
      lname=2
 
180
    endif
 
181
  name(lname:lname)=copt
 
182
  optarg=''
 
183
  if(lopt.lt.len(optionstring)) then
 
184
   if (optionstring(lopt+1:lopt+1).eq.':') then
 
185
    if(lcur.gt.larg) then
 
186
      optind=optind+1
 
187
      if(optind.gt.narg) then
 
188
        name=':'
 
189
        optarg=copt
 
190
        RETURN
 
191
      endif
 
192
      call get_command_argument(number=optind,value=carg)
 
193
      larg=len_trim(carg)
 
194
      lcur=1
 
195
    endif
 
196
    optarg=carg(lcur:larg)
 
197
    lcur=larg+1
 
198
   endif
 
199
  endif
 
200
end subroutine
 
201
end module m_getopts