quantum-espresso/COUPLE/examples/f2pw.f90

!
! 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