1!---------------------------------------------------------------------------- 2MODULE mp_world 3 !---------------------------------------------------------------------------- 4 ! 5 USE parallel_include 6 USE mp, ONLY : mp_barrier, mp_start, mp_end, mp_stop 7 USE mp, ONLY : mp_count_nodes 8 ! 9 IMPLICIT NONE 10 SAVE 11 ! 12 ! ... World group - all QE routines using mp_world_start to start MPI 13 ! ... will work in the communicator passed as input to mp_world_start 14 ! 15 INTEGER :: nnode = 1 ! number of nodes 16 INTEGER :: nproc = 1 ! number of processors 17 INTEGER :: mpime = 0 ! processor index (starts from 0 to nproc-1) 18 INTEGER :: root = 0 ! index of the root processor 19 INTEGER :: world_comm = 0 ! communicator 20 ! 21 ! ... library_mode =.true. if QE is called as a library by an external code 22 ! ... if true, MPI_Init() is not called when starting MPI, 23 ! ... MPI_Finalize() is not called when stopping MPI 24 ! 25 ! 26#if defined(__MPI) 27 LOGICAL :: library_mode = .FALSE. 28#endif 29 PRIVATE 30 PUBLIC :: nnode, nproc, mpime, root, world_comm, mp_world_start, mp_world_end 31 ! 32CONTAINS 33 ! 34 !----------------------------------------------------------------------- 35 SUBROUTINE mp_world_start ( my_world_comm ) 36 !----------------------------------------------------------------------- 37 ! 38 IMPLICIT NONE 39 INTEGER, INTENT(IN) :: my_world_comm 40#if defined(__MPI) 41 INTEGER :: ierr 42#endif 43#if defined(_OPENMP) 44 INTEGER :: PROVIDED 45#endif 46 ! 47 world_comm = my_world_comm 48 ! 49 ! ... check if mpi is already initialized (library mode) or not 50 ! 51#if defined(__MPI) 52 CALL MPI_Initialized ( library_mode, ierr) 53 IF (ierr/=0) CALL mp_stop( 8000 ) 54 IF (.NOT. library_mode ) THEN 55#if defined(_OPENMP) 56 CALL MPI_Init_thread(MPI_THREAD_FUNNELED, PROVIDED, ierr) 57#else 58 CALL MPI_Init(ierr) 59#endif 60 IF (ierr/=0) CALL mp_stop( 8001 ) 61 END IF 62#endif 63 ! 64 CALL mp_start( nproc, mpime, world_comm ) 65 !CALL mp_count_nodes ( nnode, world_comm ) 66 ! 67 RETURN 68 ! 69 END SUBROUTINE mp_world_start 70 ! 71 !----------------------------------------------------------------------- 72 SUBROUTINE mp_world_end ( ) 73 !----------------------------------------------------------------------- 74#if defined(__MPI) 75 INTEGER :: ierr 76#endif 77 ! 78 CALL mp_barrier( world_comm ) 79 CALL mp_end ( world_comm, .true. ) 80#if defined(__MPI) 81 CALL mpi_finalize(ierr) 82 IF (ierr/=0) CALL mp_stop( 8002 ) 83#endif 84 ! 85 END SUBROUTINE mp_world_end 86 ! 87END MODULE mp_world 88