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