1! --- 2! Copyright (C) 1996-2016 The SIESTA group 3! This file is distributed under the terms of the 4! GNU General Public License: see COPYING in the top directory 5! or http://www.gnu.org/copyleft/gpl.txt . 6! See Docs/Contributors.txt for a list of contributors. 7! --- 8MODULE MPI_SIESTA 9! 10! This module embodies three different things: 11! 12! - MPI interfaces for the subset of routines and types needed in Siesta 13! - A trick to make mpi_comm_world into a variable that can be reset 14! inside the code. 15! - Time-profiling of a few key MPI routines 16! 17#ifndef NO_MPI_INTERFACES 18! 19! This is an interface to supplant some MPI routines called by siesta, 20! in order to time-profile them. J.M.Soler. May.2009 21! 22 USE MPI_INTERFACES, & 23 trueMPI_BARRIER => MPI_BARRIER, & ! Renamed to avoid conflicts 24 trueMPI_COMM_RANK => MPI_COMM_RANK, & 25 trueMPI_COMM_SIZE => MPI_COMM_SIZE, & 26 trueMPI_COMM_SPLIT => MPI_COMM_SPLIT, & 27 trueMPI_GET_COUNT => MPI_GET_COUNT, & 28 trueMPI_INIT => MPI_INIT, & 29 trueMPI_WAIT => MPI_WAIT, & 30 trueMPI_WAITALL => MPI_WAITALL, & 31 true_MPI_Comm_World => MPI_Comm_World ! Note 32 33 USE TIMER_MPI_M, only: timer_mpi 34 35#else /* NO_MPI_INTERFACES */ 36! Removed interfaces and timing versions of the MPI routines. 37 USE MPI__INCLUDE, true_MPI_Comm_World => MPI_Comm_World 38#endif /* NO_MPI_INTERFACES */ 39 40! The following construction allows to supplant MPI_Comm_World within SIESTA, 41! and to use it as a subroutine with its own internal MPI communicator. 42 43 integer, public :: MPI_Comm_World = true_MPI_Comm_World 44 45 public :: true_MPI_Comm_World 46 47 48#ifdef GRID_SP 49 integer, parameter :: MPI_grid_real = MPI_real 50#elif defined(GRID_DP) 51 integer, parameter :: MPI_grid_real = MPI_double_precision 52#else 53 integer, parameter :: MPI_grid_real = MPI_double_precision 54#endif 55 56! 57! Export explicitly some symbols to help some versions of 58! the PGI compiler, which do not consider them public by default 59! 60 public :: mpi_real 61 public :: mpi_complex 62 public :: mpi_double_complex 63 public :: mpi_double_precision 64 public :: mpi_2double_precision 65 public :: mpi_integer, mpi_character, mpi_logical 66 public :: mpi_integer8 67 public :: mpi_packed 68 public :: mpi_maxloc, mpi_sum, mpi_max, mpi_lor 69 public :: mpi_status_size 70 public :: mpi_comm_self 71 public :: mpi_grid_real 72 public :: mpi_finalize 73 public :: mpi_group_null, mpi_comm_null, mpi_proc_null 74! public :: mpi_thread_single 75 public :: mpi_thread_funneled 76 77 78#ifndef NO_MPI_INTERFACES 79 PUBLIC :: MPI_BARRIER 80 INTERFACE MPI_BARRIER 81 MODULE PROCEDURE myMPI_BARRIER 82 END INTERFACE 83 84 PUBLIC :: MPI_COMM_RANK 85 INTERFACE MPI_COMM_RANK 86 MODULE PROCEDURE myMPI_COMM_RANK 87 END INTERFACE 88 89 PUBLIC :: MPI_COMM_SIZE 90 INTERFACE MPI_COMM_SIZE 91 MODULE PROCEDURE myMPI_COMM_SIZE 92 END INTERFACE 93 94 PUBLIC :: MPI_COMM_SPLIT 95 INTERFACE MPI_COMM_SPLIT 96 MODULE PROCEDURE myMPI_COMM_SPLIT 97 END INTERFACE 98 99 PUBLIC :: MPI_GET_COUNT 100 INTERFACE MPI_GET_COUNT 101 MODULE PROCEDURE myMPI_GET_COUNT 102 END INTERFACE 103 104 PUBLIC :: MPI_INIT 105 INTERFACE MPI_INIT 106 MODULE PROCEDURE myMPI_INIT 107 END INTERFACE 108 109 PUBLIC :: MPI_WAIT 110 INTERFACE MPI_WAIT 111 MODULE PROCEDURE myMPI_WAIT 112 END INTERFACE 113 114 PUBLIC :: MPI_WAITALL 115 INTERFACE MPI_WAITALL 116 MODULE PROCEDURE myMPI_WAITALL 117 END INTERFACE 118 119CONTAINS 120 121 SUBROUTINE myMPI_BARRIER(COMM, IERROR) 122 INTEGER, INTENT(IN) :: COMM 123 INTEGER, INTENT(OUT) :: IERROR 124 external MPI_BARRIER 125 call timer_mpi('MPI_BARRIER',1) 126 call MPI_BARRIER(COMM, IERROR) 127 call timer_mpi('MPI_BARRIER',2) 128 END SUBROUTINE myMPI_BARRIER 129 130 SUBROUTINE myMPI_COMM_RANK(COMM, RANK, IERROR) 131 INTEGER, INTENT(IN) :: COMM 132 INTEGER, INTENT(OUT) :: RANK 133 INTEGER, INTENT(OUT) :: IERROR 134 external MPI_COMM_RANK 135 call timer_mpi('MPI_COMM_RANK',1) 136 call MPI_COMM_RANK(COMM, RANK, IERROR) 137 call timer_mpi('MPI_COMM_RANK',2) 138 END SUBROUTINE myMPI_COMM_RANK 139 140 SUBROUTINE myMPI_COMM_SIZE(COMM, SIZE, IERROR) 141 INTEGER, INTENT(IN) :: COMM 142 INTEGER, INTENT(OUT) :: SIZE 143 INTEGER, INTENT(OUT) :: IERROR 144 external MPI_COMM_SIZE 145 call timer_mpi('MPI_COMM_SIZE',1) 146 call MPI_COMM_SIZE(COMM, SIZE, IERROR) 147 call timer_mpi('MPI_COMM_SIZE',2) 148 END SUBROUTINE myMPI_COMM_SIZE 149 150 SUBROUTINE myMPI_COMM_SPLIT(COMM, COLOR, KEY, NEWCOMM, IERROR) 151 INTEGER, INTENT(IN) :: COMM 152 INTEGER, INTENT(IN) :: COLOR 153 INTEGER, INTENT(IN) :: KEY 154 INTEGER, INTENT(OUT) :: NEWCOMM 155 INTEGER, INTENT(OUT) :: IERROR 156 external MPI_COMM_SPLIT 157 call timer_mpi('MPI_COMM_SPLIT',1) 158 call MPI_COMM_SPLIT(COMM, COLOR, KEY, NEWCOMM, IERROR) 159 call timer_mpi('MPI_COMM_SPLIT',2) 160 END SUBROUTINE myMPI_COMM_SPLIT 161 162 SUBROUTINE myMPI_GET_COUNT(STATUS, DATATYPE, COUNT, IERROR) 163 USE MPI__INCLUDE, ONLY: MPI_STATUS_SIZE 164 INTEGER, INTENT(IN) :: STATUS(MPI_STATUS_SIZE) 165 INTEGER, INTENT(IN) :: DATATYPE 166 INTEGER, INTENT(OUT) :: COUNT 167 INTEGER, INTENT(OUT) :: IERROR 168 external MPI_GET_COUNT 169 call timer_mpi('MPI_GET_COUNT',1) 170 call MPI_GET_COUNT(STATUS, DATATYPE, COUNT, IERROR) 171 call timer_mpi('MPI_GET_COUNT',2) 172 END SUBROUTINE myMPI_GET_COUNT 173 174 SUBROUTINE myMPI_INIT(IERROR) 175 INTEGER, INTENT(OUT) :: IERROR 176 external MPI_INIT 177 call timer_mpi('MPI_INIT',1) 178 call MPI_INIT(IERROR) 179 call timer_mpi('MPI_INIT',2) 180 END SUBROUTINE myMPI_INIT 181 182 SUBROUTINE myMPI_WAIT(REQUEST, STATUS, IERROR) 183 USE MPI__INCLUDE, ONLY: MPI_STATUS_SIZE 184 INTEGER, INTENT(INOUT) :: REQUEST 185 INTEGER, INTENT(OUT) :: STATUS(MPI_STATUS_SIZE) 186 INTEGER, INTENT(OUT) :: IERROR 187 external MPI_WAIT 188 call timer_mpi('MPI_WAIT',1) 189 call MPI_WAIT(REQUEST, STATUS, IERROR) 190 call timer_mpi('MPI_WAIT',2) 191 END SUBROUTINE myMPI_WAIT 192 193 SUBROUTINE myMPI_WAITALL( & 194 COUNT, ARRAY_OF_REQUESTS, ARRAY_OF_STATUSES, IERROR) 195 USE MPI__INCLUDE, ONLY: MPI_STATUS_SIZE 196 INTEGER, INTENT(IN) :: COUNT 197 INTEGER, INTENT(INOUT) :: ARRAY_OF_REQUESTS(*) 198 INTEGER, INTENT(OUT) :: ARRAY_OF_STATUSES(MPI_STATUS_SIZE,*) 199 INTEGER, INTENT(OUT) :: IERROR 200 external MPI_WAITALL 201 call timer_mpi('MPI_WAITALL',1) 202 call MPI_WAITALL(COUNT, ARRAY_OF_REQUESTS, ARRAY_OF_STATUSES, IERROR) 203 call timer_mpi('MPI_WAITALL',2) 204 END SUBROUTINE myMPI_WAITALL 205 206#endif /* ! NO_MPI_INTERFACES */ 207END MODULE MPI_SIESTA 208