mirror of https://gitlab.com/QEF/q-e.git
103 lines
2.9 KiB
Fortran
103 lines
2.9 KiB
Fortran
!
|
|
! 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
|