1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227
|
!
! Copyright (C) 2013 Quantum ESPRESSO group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!----------------------------------------------------------------------------
MODULE command_line_options
!----------------------------------------------------------------------------
!
! ... Utilities to read command-line variables and to set related variables:
! ... "get_command_line()" with no arguments:
! ... reads the command line,
! ... interprets QE-specific variables,
! ... stores the corresponding values
! ... (nimage, npot, npool, ntg, nband, ndiag),
! ... broadcasts them to all processors,
! ... leaves the rest of the command line
! ... (including the code name) in "command_line"
! ... "get_command_line(input_command_line)" with a string argument:
! ... as above, but reading from the input string
! ... Variables are read on one processor and broadcast to all others
! ... because there is no guarantee that all processors have access to
! ... command-line options in parallel execution.
! ... "set_command_line" directly sets nimage, npot, npool, ntg, nband, ndiag.
! ... Useful to initialize parallelism when QE is used as a library
!
USE mp, ONLY : mp_bcast
USE mp_world, ONLY : root, world_comm
USE io_global, ONLY : meta_ionode
!
IMPLICIT NONE
SAVE
!
! ... Number of arguments in command line
INTEGER :: nargs = 0
! ... QE arguments read from command line
INTEGER :: nimage_= 1, npool_= 1, npot_= 1, ndiag_ = 0, nband_= 1, ntg_= 1
! ... Indicate if using library init
LOGICAL :: library_init = .FALSE.
! ... input file name read from command line
CHARACTER(LEN=256) :: input_file_ = ' '
! ... Command line arguments that were not identified and processed
CHARACTER(LEN=512) :: command_line = ' '
!
CONTAINS
!
SUBROUTINE get_command_line ( input_command_line )
IMPLICIT NONE
CHARACTER(LEN=*), OPTIONAL :: input_command_line
INTEGER :: narg
! Do not define iargc as external: gfortran doesn't like it
INTEGER :: iargc
LOGICAL :: read_string
CHARACTER(LEN=256) :: arg
CHARACTER(LEN=6), EXTERNAL :: int_to_char
!
command_line = ' '
read_string = PRESENT ( input_command_line )
!
! command line parameters have already been set via set_command_line()
IF (library_init) GO TO 20
!
IF (read_string) THEN
nargs = my_iargc ( input_command_line )
ELSE
nargs = iargc()
ENDIF
CALL mp_bcast ( nargs, root, world_comm )
!
! ... Only the first node reads and broadcasts
!
IF ( .NOT. meta_ionode ) GO TO 20
!
arg = ' '
narg=0
10 CONTINUE
IF (read_string) THEN
CALL my_getarg ( input_command_line, narg, arg )
ELSE
CALL getarg ( narg, arg )
ENDIF
narg = narg + 1
SELECT CASE ( TRIM(arg) )
CASE ( '-i', '-in', '-inp', '-input' )
IF (read_string) THEN
CALL my_getarg ( input_command_line, narg, input_file_ )
ELSE
CALL getarg ( narg, input_file_ )
ENDIF
IF ( TRIM (input_file_) == ' ' ) GO TO 15
narg = narg + 1
CASE ( '-ni', '-nimage', '-nimages' )
IF (read_string) THEN
CALL my_getarg ( input_command_line, narg, arg )
ELSE
CALL getarg ( narg, arg )
ENDIF
READ ( arg, *, ERR = 15, END = 15) nimage_
narg = narg + 1
CASE ( '-npot', '-npots' )
IF (read_string) THEN
CALL my_getarg ( input_command_line, narg, arg )
ELSE
CALL getarg ( narg, arg )
ENDIF
READ ( arg, *, ERR = 15, END = 15) npot_
narg = narg + 1
CASE ( '-nk', '-npool', '-npools')
IF (read_string) THEN
CALL my_getarg ( input_command_line, narg, arg )
ELSE
CALL getarg ( narg, arg )
ENDIF
READ ( arg, *, ERR = 15, END = 15) npool_
narg = narg + 1
CASE ( '-nt', '-ntg', '-ntask_groups')
IF (read_string) THEN
CALL my_getarg ( input_command_line, narg, arg )
ELSE
CALL getarg ( narg, arg )
ENDIF
READ ( arg, *, ERR = 15, END = 15) ntg_
narg = narg + 1
CASE ( '-nb', '-nband', '-nbgrp', '-nband_group')
IF (read_string) THEN
CALL my_getarg ( input_command_line, narg, arg )
ELSE
CALL getarg ( narg, arg )
ENDIF
READ ( arg, *, ERR = 15, END = 15) nband_
narg = narg + 1
CASE ( '-nd', '-ndiag', '-northo', '-nproc_diag', '-nproc_ortho')
IF (read_string) THEN
CALL my_getarg ( input_command_line, narg, arg )
ELSE
CALL getarg ( narg, arg )
ENDIF
READ ( arg, *, ERR = 15, END = 15) ndiag_
narg = narg + 1
CASE DEFAULT
command_line = TRIM(command_line) // ' ' // TRIM(arg)
END SELECT
IF ( narg > nargs ) GO TO 20
GO TO 10
! ... something wrong: notify and continue
15 CALL infomsg ('get_command_line', 'unexpected argument # ' // &
& int_to_char(narg) // ':' //TRIM(arg))
narg = narg + 1
GO TO 10
! ... normal exit
20 CONTINUE
CALL mp_bcast( command_line, root, world_comm )
CALL mp_bcast( input_file_ , root, world_comm )
CALL mp_bcast( nimage_, root, world_comm )
CALL mp_bcast( npot_ , root, world_comm )
CALL mp_bcast( npool_ , root, world_comm )
CALL mp_bcast( ntg_ , root, world_comm )
CALL mp_bcast( nband_ , root, world_comm )
CALL mp_bcast( ndiag_ , root, world_comm )
END SUBROUTINE get_command_line
!
INTEGER FUNCTION my_iargc ( input_command_line )
IMPLICIT NONE
CHARACTER(LEN=*), INTENT(IN) :: input_command_line
CHARACTER(LEN=1) :: previous, current
INTEGER :: i
my_iargc = 0
previous = ' '
DO i=1,LEN_TRIM(input_command_line)
current = input_command_line(i:i)
IF ( current /= ' ' .AND. previous == ' ' ) my_iargc = my_iargc+1
previous = current
END DO
END FUNCTION my_iargc
!
SUBROUTINE my_getarg ( input_command_line, narg, arg )
IMPLICIT NONE
CHARACTER(LEN=*), INTENT(IN) :: input_command_line
INTEGER, INTENT(IN) :: narg
CHARACTER(LEN=*), INTENT(OUT) :: arg
CHARACTER(LEN=1) :: previous, current
INTEGER :: iarg, i, indx
iarg = 0
previous = ' '
arg = ' '
indx= 0
DO i=1,LEN_TRIM(input_command_line)
current = input_command_line(i:i)
IF ( current /= ' ' .AND. previous == ' ' ) iarg = iarg+1
IF ( iarg == narg ) THEN
indx = indx + 1
arg(indx:indx) = current
IF ( indx == LEN(arg) ) RETURN
ELSE IF ( iarg > narg ) THEN
RETURN
END IF
previous = current
END DO
END SUBROUTINE my_getarg
SUBROUTINE set_command_line ( nimage, npot, npool, ntg, nband, ndiag)
! directly set command line options without going through the command line
IMPLICIT NONE
INTEGER, INTENT(IN), OPTIONAL :: nimage, npot, npool, ntg, nband, ndiag
!
IF ( PRESENT(nimage) ) nimage_ = nimage
IF ( PRESENT(npot) ) npot_ = npot
IF ( PRESENT(npool) ) npool_ = npool
IF ( PRESENT(ntg) ) ntg_ = ntg
IF ( PRESENT(nband) ) nband_ = nband
IF ( PRESENT(ndiag) ) ndiag_ = ndiag
!
library_init = .TRUE.
!
END SUBROUTINE set_command_line
!
END MODULE command_line_options
|