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