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