Subversion Repositories tropofold.echam

Rev

Rev 3 | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed 

! F2KCLI : Fortran 200x Command Line Interface
! copyright Interactive Software Services Ltd. 2001
! For conditions of use see manual.txt
!
! Platform    : Unix/Linux
! Compiler    : Any Fortran 9x compiler supporting IARGC/GETARG
!               which counts the first true command line argument
!               after the program name as argument number one.
!               (Excludes compilers which require a special USE
!               statement to make IARGC/GETARG available).
! To compile  : f90 -c f2kcli.f90
!               (exact compiler name will vary)
! Implementer : Lawson B. Wakefield, I.S.S. Ltd.
! Date        : February 2001
!
     MODULE MO_F2KCLI
#if defined (NAG)
        USE f90_unix
!#else
!        EXTERNAL  :: GETARG, IARG, IARGC
#endif
!        INTRINSIC :: LEN_TRIM, PRESENT, LEN
!        PRIVATE   :: LEN_TRIM, PRESENT, LEN
!        INTEGER   :: IARGC
!
      CONTAINS
!
      SUBROUTINE GET_COMMAND(COMMAND,LENGTH,STATUS)
!
! Description. Returns the entire command by which the program was
!   invoked.
!
! Class. Subroutine.
!
! Arguments.
! COMMAND (optional) shall be scalar and of type default character.
!   It is an INTENT(OUT) argument. It is assigned the entire command
!   by which the program was invoked. If the command cannot be
!   determined, COMMAND is assigned all blanks.
! LENGTH (optional) shall be scalar and of type default integer. It is
!   an INTENT(OUT) argument. It is assigned the significant length
!   of the command by which the program was invoked. The significant
!   length may include trailing blanks if the processor allows commands
!   with significant trailing blanks. This length does not consider any
!   possible truncation or padding in assigning the command to the
!   COMMAND argument; in fact the COMMAND argument need not even be
!   present. If the command length cannot be determined, a length of
!   0 is assigned.
! STATUS (optional) shall be scalar and of type default integer. It is
!   an INTENT(OUT) argument. It is assigned the value 0 if the
!   command retrieval is sucessful. It is assigned a processor-dependent
!   non-zero value if the command retrieval fails.
!
      CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: COMMAND
      INTEGER         , INTENT(OUT), OPTIONAL :: LENGTH
      INTEGER         , INTENT(OUT), OPTIONAL :: STATUS
!
      INTEGER                   :: IARG,NARG,IPOS
      INTEGER            , SAVE :: LENARG
      CHARACTER(LEN=2000), SAVE :: ARGSTR
      LOGICAL            , SAVE :: GETCMD = .TRUE.
!
! Under Unix we must reconstruct the command line from its constituent
! parts. This will not be the original command line. Rather it will be
! the expanded command line as generated by the shell.
!
      IF (GETCMD) THEN
          NARG = IARGC()
          IF (NARG > 0) THEN
              IPOS = 1
              DO IARG = 1,NARG
                CALL GETARG(IARG,ARGSTR(IPOS:))
                LENARG = LEN_TRIM(ARGSTR)
                IPOS   = LENARG + 2
                IF (IPOS > LEN(ARGSTR)) EXIT
              END DO
          ELSE
              ARGSTR = ' '
              LENARG = 0
          ENDIF
          GETCMD = .FALSE.
      ENDIF
      IF (PRESENT(COMMAND)) COMMAND = ARGSTR
      IF (PRESENT(LENGTH))  LENGTH  = LENARG
      IF (PRESENT(STATUS))  STATUS  = 0
      RETURN
      END SUBROUTINE GET_COMMAND
!
      INTEGER FUNCTION COMMAND_ARGUMENT_COUNT()
!
! Description. Returns the number of command arguments.
!
! Class. Inquiry function
!
! Arguments. None.
!
! Result Characteristics. Scalar default integer.
!
! Result Value. The result value is equal to the number of command
!   arguments available. If there are no command arguments available
!   or if the processor does not support command arguments, then
!   the result value is 0. If the processor has a concept of a command
!   name, the command name does not count as one of the command
!   arguments.
!
      COMMAND_ARGUMENT_COUNT = IARGC()
      RETURN
      END FUNCTION COMMAND_ARGUMENT_COUNT
!
      SUBROUTINE GET_COMMAND_ARGUMENT(NUMBER,VALUE,LENGTH,STATUS)
!
! Description. Returns a command argument.
!
! Class. Subroutine.
!
! Arguments.
! NUMBER shall be scalar and of type default integer. It is an
!   INTENT(IN) argument. It specifies the number of the command
!   argument that the other arguments give information about. Useful
!   values of NUMBER are those between 0 and the argument count
!   returned by the COMMAND_ARGUMENT_COUNT intrinsic.
!   Other values are allowed, but will result in error status return
!   (see below).  Command argument 0 is defined to be the command
!   name by which the program was invoked if the processor has such
!   a concept. It is allowed to call the GET_COMMAND_ARGUMENT
!   procedure for command argument number 0, even if the processor
!   does not define command names or other command arguments.
!   The remaining command arguments are numbered consecutively from
!   1 to the argument count in an order determined by the processor.
! VALUE (optional) shall be scalar and of type default character.
!   It is an INTENT(OUT) argument. It is assigned the value of the
!   command argument specified by NUMBER. If the command argument value
!   cannot be determined, VALUE is assigned all blanks.
! LENGTH (optional) shall be scalar and of type default integer.
!   It is an INTENT(OUT) argument. It is assigned the significant length
!   of the command argument specified by NUMBER. The significant
!   length may include trailing blanks if the processor allows command
!   arguments with significant trailing blanks. This length does not
!   consider any possible truncation or padding in assigning the
!   command argument value to the VALUE argument; in fact the
!   VALUE argument need not even be present. If the command
!   argument length cannot be determined, a length of 0 is assigned.
! STATUS (optional) shall be scalar and of type default integer.
!   It is an INTENT(OUT) argument. It is assigned the value 0 if
!   the argument retrieval is sucessful. It is assigned a
!   processor-dependent non-zero value if the argument retrieval fails.
!
! NOTE
!   One possible reason for failure is that NUMBER is negative or
!   greater than COMMAND_ARGUMENT_COUNT().
!
      INTEGER         , INTENT(IN)            :: NUMBER
      CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: VALUE
      INTEGER         , INTENT(OUT), OPTIONAL :: LENGTH
      INTEGER         , INTENT(OUT), OPTIONAL :: STATUS
!
!  A temporary variable for the rare case case where LENGTH is
!  specified but VALUE is not. An arbitrary maximum argument length
!  of 1000 characters should cover virtually all situations.
!
      CHARACTER(LEN=1000) :: TMPVAL
!
! Possible error codes:
! 1 = Argument number is less than minimum
! 2 = Argument number exceeds maximum
!
      IF (NUMBER < 0) THEN
          IF (PRESENT(VALUE )) VALUE  = ' '
          IF (PRESENT(LENGTH)) LENGTH = 0
          IF (PRESENT(STATUS)) STATUS = 1
          RETURN
      ELSE IF (NUMBER > IARGC()) THEN
          IF (PRESENT(VALUE )) VALUE  = ' '
          IF (PRESENT(LENGTH)) LENGTH = 0
          IF (PRESENT(STATUS)) STATUS = 2
          RETURN
      END IF
!
! Get the argument if VALUE is present
!
      IF (PRESENT(VALUE)) CALL GETARG(NUMBER,VALUE)
!
! The LENGTH option is fairly pointless under Unix.
! Trailing spaces can only be specified using quotes.
! Since the command line has already been processed by the
! shell before the application sees it, we have no way of
! knowing the true length of any quoted arguments. LEN_TRIM
! is used to ensure at least some sort of meaningful result.
!
      IF (PRESENT(LENGTH)) THEN
          IF (PRESENT(VALUE)) THEN
              LENGTH = LEN_TRIM(VALUE)
          ELSE
              CALL GETARG(NUMBER,TMPVAL)
              LENGTH = LEN_TRIM(TMPVAL)
          END IF
      END IF
!
! Since GETARG does not return a result code, assume success
!
      IF (PRESENT(STATUS)) STATUS = 0
      RETURN
      END SUBROUTINE GET_COMMAND_ARGUMENT
!
    END MODULE MO_F2KCLI