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
|
!
! 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 .
!
!----------------------------------------------------------------------------
PROGRAM qecouple
!----------------------------------------------------------------------------
!
! ... Test program for Q-E library interface
!
IMPLICIT NONE
INCLUDE 'mpif.h'
!
INTEGER :: i, exit_status, ierr, ncpu, me, key, new_comm, nargs
INTEGER :: nimage, npots, npools, ntg, nband, ndiag, nres
CHARACTER(LEN=80) :: input_file, arg
!
! set defaults
nimage = 1
npots = 1
npools = 1
ntg = 1
nband = 1
ndiag = 1
nres = 0
input_file = ' '
!
! MPI setup
CALL mpi_init(ierr)
CALL mpi_comm_size(MPI_COMM_WORLD,ncpu,ierr)
CALL mpi_Comm_rank(MPI_COMM_WORLD,me,ierr)
!
! parse command line flags
nargs = command_argument_count()
i = 1
DO
CALL getarg(i,arg)
IF (LEN_TRIM(arg) == 0) EXIT
!
i = i + 1
IF (i > nargs) EXIT
!
SELECT CASE ( TRIM(arg) )
!
CASE ( '-i', '-in', '-inp', '-input' )
CALL getarg(i, input_file)
IF ( TRIM (input_file) == ' ') GO TO 15
i = i + 1
CASE ( '-ni', '-nimage', '-nimages' )
CALL getarg(i, arg)
READ ( arg, *, ERR = 15, END = 15) nimage
i = i + 1
CASE ( '-nk', '-npool', '-npools')
CALL getarg(i, arg)
READ ( arg, *, ERR = 15, END = 15) npools
i = i + 1
CASE ( '-nt', '-ntg', '-ntask_groups')
CALL getarg(i, arg)
READ ( arg, *, ERR = 15, END = 15) ntg
i = i + 1
CASE ( '-nb', '-nband', '-nbgrp', '-nband_group')
CALL getarg(i, arg)
READ ( arg, *, ERR = 15, END = 15) nband
i = i + 1
CASE ( '-nd', '-ndiag', '-northo', '-nproc_diag', '-nproc_ortho')
CALL getarg(i, arg)
READ ( arg, *, ERR = 15, END = 15) ndiag
i = i + 1
CASE ( '-nr', '-nres', '-nreserved')
CALL getarg(i, arg)
READ ( arg, *, ERR = 15, END = 15) nres
i = i + 1
CASE DEFAULT
PRINT*, 'unknown input flag: ',TRIM(arg)
CALL mpi_abort(MPI_COMM_WORLD,-1,ierr)
END SELECT
END DO
15 CONTINUE
key = MPI_UNDEFINED
IF (me < (ncpu - nres)) key = 1
CALL mpi_comm_split(MPI_COMM_WORLD, key, me, new_comm, ierr)
IF (new_comm /= MPI_COMM_NULL) THEN
CALL f2libpwscf(new_comm,nimage,npots,npools,ntg,nband,ndiag, &
exit_status, input_file)
PRINT *, 'Call to libpwscf finished with exit status', exit_status
ELSE
PRINT *, 'Reserved CPU rank:', me, " of", ncpu-1
exit_status = 0
END IF
!
CALL mpi_finalize(ierr)
CALL do_stop( exit_status )
!
STOP
!
END PROGRAM qecouple
|
