| 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 |
