1! 2! Copyright (C) 2001-2015 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 mp_world 10 !---------------------------------------------------------------------------- 11 ! 12 USE mp, ONLY : mp_barrier, mp_start, mp_end, mp_stop, mp_count_nodes 13 USE io_global, ONLY : meta_ionode_id, meta_ionode 14 ! 15 USE parallel_include 16 ! 17 IMPLICIT NONE 18 SAVE 19 ! 20 ! ... World group - all QE routines using mp_world_start to start MPI 21 ! ... will work in the communicator passed as input to mp_world_start 22 ! 23 INTEGER :: nnode = 1 ! number of nodes 24 INTEGER :: nproc = 1 ! number of processors 25 INTEGER :: mpime = 0 ! processor index (starts from 0 to nproc-1) 26 INTEGER :: root = 0 ! index of the root processor 27 INTEGER :: world_comm = 0 ! communicator 28 ! 29 ! ... library_mode =.true. if QE is called as a library by an external code 30 ! ... if true, MPI_Init() is not called when starting MPI, 31 ! ... MPI_Finalize() is not called when stopping MPI 32 ! 33#if defined(__MPI) 34 LOGICAL :: library_mode = .FALSE. 35#endif 36 ! 37 PRIVATE 38 PUBLIC :: nnode, nproc, mpime, root, world_comm, mp_world_start, mp_world_end 39 ! 40CONTAINS 41 ! 42 !----------------------------------------------------------------------- 43 SUBROUTINE mp_world_start ( my_world_comm ) 44 !----------------------------------------------------------------------- 45 ! 46 IMPLICIT NONE 47 INTEGER, INTENT(IN) :: my_world_comm 48 INTEGER :: color, key 49#if defined(__MPI) 50 INTEGER :: ierr 51#endif 52#if defined(_OPENMP) 53 INTEGER :: PROVIDED 54#endif 55 ! 56 world_comm = my_world_comm 57 ! 58 ! ... check if mpi is already initialized (library mode) or not 59 ! 60#if defined(__MPI) 61 CALL MPI_Initialized ( library_mode, ierr) 62 IF (ierr/=0) CALL mp_stop( 8000 ) 63 IF (.NOT. library_mode ) THEN 64#if defined(_OPENMP) 65 CALL MPI_Init_thread(MPI_THREAD_MULTIPLE, PROVIDED, ierr) 66#else 67 CALL MPI_Init(ierr) 68#endif 69 IF (ierr/=0) CALL mp_stop( 8001 ) 70 END IF 71#endif 72 ! 73 CALL mp_start( nproc, mpime, world_comm ) 74 ! 75 CALL mp_count_nodes ( nnode, color, key, world_comm ) 76 ! 77 ! 78 ! ... meta_ionode is true if this processor is the root processor 79 ! ... of the world group - "ionode_world" would be a better name 80 ! ... meta_ionode_id is the index of such processor 81 ! 82 meta_ionode = ( mpime == root ) 83 meta_ionode_id = root 84 ! 85 RETURN 86 ! 87 END SUBROUTINE mp_world_start 88 ! 89 !----------------------------------------------------------------------- 90 SUBROUTINE mp_world_end ( ) 91 !----------------------------------------------------------------------- 92#if defined(__MPI) 93 INTEGER :: ierr 94#endif 95 ! 96 CALL mp_barrier( world_comm ) 97 CALL mp_end ( world_comm ) 98#if defined(__MPI) 99 IF (.NOT. library_mode ) THEN 100 CALL mpi_finalize(ierr) 101 IF (ierr/=0) CALL mp_stop( 8002 ) 102 END IF 103#endif 104 ! 105 END SUBROUTINE mp_world_end 106 ! 107END MODULE mp_world 108