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