1! F2KCLI : Fortran 200x Command Line Interface
2! copyright Interactive Software Services Ltd. 2001
3! For conditions of use see f2kcli_manual.txt
4!
5! Platform    : Unix/Linux
6! Compiler    : Any Fortran 9x compiler supporting IARGC/GETARG
7!               which counts the first true command line argument
8!               after the program name as argument number one.
9!               (Excludes compilers which require a special USE
10!               statement to make IARGC/GETARG available).
11!AG
12!AG:            Support for F through conditional compilation...
13!AG
14! To compile  : f90 -c f2kcli.f90
15!               (exact compiler name will vary)
16! Implementer : Lawson B. Wakefield, I.S.S. Ltd.
17! Date        : February 2001
18!
19      MODULE F2KCLI
20#if  !defined(GFORTRAN) && !defined(__GFORTRAN__)
21
22#ifdef __NAG__
23      use f90_unix
24#else
25      interface
26         function iargc() result(count)
27         integer :: count
28         end function iargc
29      end interface
30      interface
31         subroutine getarg(i,str)
32         integer, intent(in)            :: i
33         character(len=*), intent(out)  :: str
34         end subroutine getarg
35      end interface
36#endif
37
38      private
39!
40      public  :: get_command_argument, get_command
41      public  :: command_argument_count
42
43      CONTAINS
44!
45      SUBROUTINE GET_COMMAND(COMMAND,LENGTH,STATUS)
46!
47! Description. Returns the entire command by which the program was
48!   invoked.
49!
50! Class. Subroutine.
51!
52! Arguments.
53! COMMAND (optional) shall be scalar and of type default character.
54!   It is an INTENT(OUT) argument. It is assigned the entire command
55!   by which the program was invoked. If the command cannot be
56!   determined, COMMAND is assigned all blanks.
57! LENGTH (optional) shall be scalar and of type default integer. It is
58!   an INTENT(OUT) argument. It is assigned the significant length
59!   of the command by which the program was invoked. The significant
60!   length may include trailing blanks if the processor allows commands
61!   with significant trailing blanks. This length does not consider any
62!   possible truncation or padding in assigning the command to the
63!   COMMAND argument; in fact the COMMAND argument need not even be
64!   present. If the command length cannot be determined, a length of
65!   0 is assigned.
66! STATUS (optional) shall be scalar and of type default integer. It is
67!   an INTENT(OUT) argument. It is assigned the value 0 if the
68!   command retrieval is sucessful. It is assigned a processor-dependent
69!   non-zero value if the command retrieval fails.
70!
71      CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: COMMAND
72      INTEGER         , INTENT(OUT), OPTIONAL :: LENGTH
73      INTEGER         , INTENT(OUT), OPTIONAL :: STATUS
74!
75      INTEGER                   :: IARG,NARG,IPOS
76      INTEGER            , SAVE :: LENARG
77      CHARACTER(LEN=2000), SAVE :: ARGSTR
78      LOGICAL            , SAVE :: GETCMD = .TRUE.
79!
80! Under Unix we must reconstruct the command line from its constituent
81! parts. This will not be the original command line. Rather it will be
82! the expanded command line as generated by the shell.
83!
84      IF (GETCMD) THEN
85          NARG = IARGC()
86          IF (NARG > 0) THEN
87              IPOS = 1
88              DO IARG = 1,NARG
89                CALL GETARG(IARG,ARGSTR(IPOS:))
90                LENARG = LEN_TRIM(ARGSTR)
91                IPOS   = LENARG + 2
92                IF (IPOS > LEN(ARGSTR)) EXIT
93              END DO
94          ELSE
95              ARGSTR = " "
96              LENARG = 0
97          ENDIF
98          GETCMD = .FALSE.
99      ENDIF
100      IF (PRESENT(COMMAND)) then
101      COMMAND = ARGSTR
102      endif
103      IF (PRESENT(LENGTH)) then
104           LENGTH  = LENARG
105      endif
106      IF (PRESENT(STATUS)) then
107           STATUS  = 0
108      endif
109      RETURN
110      END SUBROUTINE GET_COMMAND
111!
112      FUNCTION COMMAND_ARGUMENT_COUNT() result(count)
113      integer                 :: count
114!
115! Description. Returns the number of command arguments.
116!
117! Class. Inquiry function
118!
119! Arguments. None.
120!
121! Result Characteristics. Scalar default integer.
122!
123! Result Value. The result value is equal to the number of command
124!   arguments available. If there are no command arguments available
125!   or if the processor does not support command arguments, then
126!   the result value is 0. If the processor has a concept of a command
127!   name, the command name does not count as one of the command
128!   arguments.
129!
130      COUNT = IARGC()
131
132      END FUNCTION COMMAND_ARGUMENT_COUNT
133!
134      SUBROUTINE GET_COMMAND_ARGUMENT(NUMBER,VALUE,LENGTH,STATUS)
135!
136! Description. Returns a command argument.
137!
138! Class. Subroutine.
139!
140! Arguments.
141! NUMBER shall be scalar and of type default integer. It is an
142!   INTENT(IN) argument. It specifies the number of the command
143!   argument that the other arguments give information about. Useful
144!   values of NUMBER are those between 0 and the argument count
145!   returned by the COMMAND_ARGUMENT_COUNT intrinsic.
146!   Other values are allowed, but will result in error status return
147!   (see below).  Command argument 0 is defined to be the command
148!   name by which the program was invoked if the processor has such
149!   a concept. It is allowed to call the GET_COMMAND_ARGUMENT
150!   procedure for command argument number 0, even if the processor
151!   does not define command names or other command arguments.
152!   The remaining command arguments are numbered consecutively from
153!   1 to the argument count in an order determined by the processor.
154! VALUE (optional) shall be scalar and of type default character.
155!   It is an INTENT(OUT) argument. It is assigned the value of the
156!   command argument specified by NUMBER. If the command argument value
157!   cannot be determined, VALUE is assigned all blanks.
158! LENGTH (optional) shall be scalar and of type default integer.
159!   It is an INTENT(OUT) argument. It is assigned the significant length
160!   of the command argument specified by NUMBER. The significant
161!   length may include trailing blanks if the processor allows command
162!   arguments with significant trailing blanks. This length does not
163!   consider any possible truncation or padding in assigning the
164!   command argument value to the VALUE argument; in fact the
165!   VALUE argument need not even be present. If the command
166!   argument length cannot be determined, a length of 0 is assigned.
167! STATUS (optional) shall be scalar and of type default integer.
168!   It is an INTENT(OUT) argument. It is assigned the value 0 if
169!   the argument retrieval is sucessful. It is assigned a
170!   processor-dependent non-zero value if the argument retrieval fails.
171!
172! NOTE
173!   One possible reason for failure is that NUMBER is negative or
174!   greater than COMMAND_ARGUMENT_COUNT().
175!
176      INTEGER         , INTENT(IN)            :: NUMBER
177      CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: VALUE
178      INTEGER         , INTENT(OUT), OPTIONAL :: LENGTH
179      INTEGER         , INTENT(OUT), OPTIONAL :: STATUS
180!
181
182
183!  A temporary variable for the rare case case where LENGTH is
184!  specified but VALUE is not. An arbitrary maximum argument length
185!  of 1000 characters should cover virtually all situations.
186!
187      CHARACTER(LEN=1000) :: TMPVAL
188!
189! Possible error codes:
190! 1 = Argument number is less than minimum
191! 2 = Argument number exceeds maximum
192!
193      IF (NUMBER < 0) THEN
194          IF (PRESENT(VALUE )) VALUE  = " "
195          IF (PRESENT(LENGTH)) LENGTH = 0
196          IF (PRESENT(STATUS)) STATUS = 1
197          RETURN
198      ELSE IF (NUMBER > IARGC()) THEN
199          IF (PRESENT(VALUE )) VALUE  = " "
200          IF (PRESENT(LENGTH)) LENGTH = 0
201          IF (PRESENT(STATUS)) STATUS = 2
202          RETURN
203      END IF
204!
205! Get the argument if VALUE is present
206!
207      IF (PRESENT(VALUE)) CALL GETARG(NUMBER,VALUE)
208!
209! The LENGTH option is fairly pointless under Unix.
210! Trailing spaces can only be specified using quotes.
211! Since the command line has already been processed by the
212! shell before the application sees it, we have no way of
213! knowing the true length of any quoted arguments. LEN_TRIM
214! is used to ensure at least some sort of meaningful result.
215!
216      IF (PRESENT(LENGTH)) THEN
217          IF (PRESENT(VALUE)) THEN
218              LENGTH = LEN_TRIM(VALUE)
219          ELSE
220              CALL GETARG(NUMBER,TMPVAL)
221              LENGTH = LEN_TRIM(TMPVAL)
222          END IF
223      END IF
224!
225! Since GETARG does not return a result code, assume success
226!
227      IF (PRESENT(STATUS)) STATUS = 0
228      RETURN
229      END SUBROUTINE GET_COMMAND_ARGUMENT
230!
231#endif  /* Gfortran already has everything */
232
233      END MODULE F2KCLI
234
235