nano_mpi/src/f2kcli.F90

! 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 F2KCLI
        USE IFLPORT!
      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 F2KCLI
Revision:	4
Committed:	Mon Jun 10 17:18:36 2002 UTC (22 years, 1 month ago) by chuckv
File size:	7821 byte(s)
Log Message:	Import Root
#	User	Rev	Content
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