1 |
chuckv |
4 |
! 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 |