Line data Source code
1 : !--------------------------------------------------------------------------------
2 : ! Copyright (c) 2023 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
3 : ! This file is part of FLEUR and available as free software under the conditions
4 : ! of the MIT license as expressed in the LICENSE file in more detail.
5 : !--------------------------------------------------------------------------------
6 :
7 : MODULE m_mpi_reduce_tool
8 :
9 : USE m_juDFT
10 : #ifdef CPP_MPI
11 : USE mpi
12 : #endif
13 :
14 : IMPLICIT NONE
15 : PRIVATE
16 :
17 : INTERFACE mpi_sum_reduce
18 : MODULE PROCEDURE mpi_sum_reduce_int1, mpi_sum_reduce_int2, mpi_sum_reduce_int3
19 : MODULE PROCEDURE mpi_sum_reduce_real1, mpi_sum_reduce_real2, mpi_sum_reduce_real3
20 : MODULE PROCEDURE mpi_sum_reduce_complex1, mpi_sum_reduce_complex2, mpi_sum_reduce_complex3
21 : END INTERFACE mpi_sum_reduce
22 :
23 : INTERFACE mpi_lor_reduce
24 : MODULE PROCEDURE mpi_lor_reduce_bool1, mpi_lor_reduce_bool2, mpi_lor_reduce_bool3
25 : END INTERFACE mpi_lor_reduce
26 :
27 : PUBLIC :: mpi_sum_reduce, mpi_lor_reduce
28 :
29 : CONTAINS
30 :
31 : ! INTEGER SUBROUTINES:
32 :
33 0 : SUBROUTINE mpi_sum_reduce_int1(sourceArray, targetArray, mpi_comm)
34 : IMPLICIT NONE
35 : INTEGER, INTENT(IN) :: sourceArray(:)
36 : INTEGER, INTENT(INOUT) :: targetArray(:)
37 : INTEGER, INTENT(IN) :: mpi_comm
38 :
39 : INTEGER :: ierr=0
40 : INTEGER :: length
41 :
42 0 : length = SIZE(sourceArray)
43 0 : IF(length.NE.SIZE(targetArray)) CALL judft_error("MPI_REDUCE failed: Array size mismatch.")
44 :
45 : #ifdef CPP_MPI
46 0 : CALL MPI_REDUCE(sourceArray, targetArray, length, MPI_INTEGER, MPI_SUM, 0, mpi_comm, ierr)
47 : #else
48 : targetArray(:) = sourceArray(:)
49 : #endif
50 0 : IF (ierr.NE.0) CALL judft_error("MPI_REDUCE failed")
51 0 : END SUBROUTINE mpi_sum_reduce_int1
52 :
53 0 : SUBROUTINE mpi_sum_reduce_int2(sourceArray, targetArray, mpi_comm)
54 : IMPLICIT NONE
55 : INTEGER, INTENT(IN) :: sourceArray(:,:)
56 : INTEGER, INTENT(INOUT) :: targetArray(:,:)
57 : INTEGER, INTENT(IN) :: mpi_comm
58 :
59 : INTEGER :: ierr=0
60 : INTEGER :: length
61 :
62 0 : length = SIZE(sourceArray)
63 0 : IF(length.NE.SIZE(targetArray)) CALL judft_error("MPI_REDUCE failed: Array size mismatch.")
64 :
65 : #ifdef CPP_MPI
66 0 : CALL MPI_REDUCE(sourceArray, targetArray, length, MPI_INTEGER, MPI_SUM, 0, mpi_comm, ierr)
67 : #else
68 : targetArray(:,:) = sourceArray(:,:)
69 : #endif
70 0 : IF (ierr.NE.0) CALL judft_error("MPI_REDUCE failed")
71 0 : END SUBROUTINE mpi_sum_reduce_int2
72 :
73 160 : SUBROUTINE mpi_sum_reduce_int3(sourceArray, targetArray, mpi_comm)
74 : IMPLICIT NONE
75 : INTEGER, INTENT(IN) :: sourceArray(:,:,:)
76 : INTEGER, INTENT(INOUT) :: targetArray(:,:,:)
77 : INTEGER, INTENT(IN) :: mpi_comm
78 :
79 : INTEGER :: ierr=0
80 : INTEGER :: length
81 :
82 640 : length = SIZE(sourceArray)
83 640 : IF(length.NE.SIZE(targetArray)) CALL judft_error("MPI_REDUCE failed: Array size mismatch.")
84 :
85 : #ifdef CPP_MPI
86 160 : CALL MPI_REDUCE(sourceArray, targetArray, length, MPI_INTEGER, MPI_SUM, 0, mpi_comm, ierr)
87 : #else
88 : targetArray(:,:,:) = sourceArray(:,:,:)
89 : #endif
90 160 : IF (ierr.NE.0) CALL judft_error("MPI_REDUCE failed")
91 160 : END SUBROUTINE mpi_sum_reduce_int3
92 :
93 : ! REAL SUBROUTINES:
94 :
95 320 : SUBROUTINE mpi_sum_reduce_real1(sourceArray, targetArray, mpi_comm)
96 : IMPLICIT NONE
97 : REAL, INTENT(IN) :: sourceArray(:)
98 : REAL, INTENT(INOUT) :: targetArray(:)
99 : INTEGER, INTENT(IN) :: mpi_comm
100 :
101 : INTEGER :: ierr=0
102 : INTEGER :: length
103 :
104 320 : length = SIZE(sourceArray)
105 320 : IF(length.NE.SIZE(targetArray)) CALL judft_error("MPI_REDUCE failed: Array size mismatch.")
106 :
107 : #ifdef CPP_MPI
108 320 : CALL MPI_REDUCE(sourceArray, targetArray, length, MPI_DOUBLE_PRECISION, MPI_SUM, 0, mpi_comm, ierr)
109 : #else
110 : targetArray(:) = sourceArray(:)
111 : #endif
112 320 : IF (ierr.NE.0) CALL judft_error("MPI_REDUCE failed")
113 320 : END SUBROUTINE mpi_sum_reduce_real1
114 :
115 6492 : SUBROUTINE mpi_sum_reduce_real2(sourceArray, targetArray, mpi_comm)
116 : IMPLICIT NONE
117 : REAL, INTENT(IN) :: sourceArray(:,:)
118 : REAL, INTENT(INOUT) :: targetArray(:,:)
119 : INTEGER, INTENT(IN) :: mpi_comm
120 :
121 : INTEGER :: ierr=0
122 : INTEGER :: length
123 :
124 19476 : length = SIZE(sourceArray)
125 19476 : IF(length.NE.SIZE(targetArray)) CALL judft_error("MPI_REDUCE failed: Array size mismatch.")
126 :
127 : #ifdef CPP_MPI
128 6492 : CALL MPI_REDUCE(sourceArray, targetArray, length, MPI_DOUBLE_PRECISION, MPI_SUM, 0, mpi_comm, ierr)
129 : #else
130 : targetArray(:,:) = sourceArray(:,:)
131 : #endif
132 6492 : IF (ierr.NE.0) CALL judft_error("MPI_REDUCE failed")
133 6492 : END SUBROUTINE mpi_sum_reduce_real2
134 :
135 0 : SUBROUTINE mpi_sum_reduce_real3(sourceArray, targetArray, mpi_comm)
136 : IMPLICIT NONE
137 : REAL, INTENT(IN) :: sourceArray(:,:,:)
138 : REAL, INTENT(INOUT) :: targetArray(:,:,:)
139 : INTEGER, INTENT(IN) :: mpi_comm
140 :
141 : INTEGER :: ierr=0
142 : INTEGER :: length
143 :
144 0 : length = SIZE(sourceArray)
145 0 : IF(length.NE.SIZE(targetArray)) CALL judft_error("MPI_REDUCE failed: Array size mismatch.")
146 :
147 : #ifdef CPP_MPI
148 0 : CALL MPI_REDUCE(sourceArray, targetArray, length, MPI_DOUBLE_PRECISION, MPI_SUM, 0, mpi_comm, ierr)
149 : #else
150 : targetArray(:,:,:) = sourceArray(:,:,:)
151 : #endif
152 0 : IF (ierr.NE.0) CALL judft_error("MPI_REDUCE failed")
153 0 : END SUBROUTINE mpi_sum_reduce_real3
154 :
155 : ! COMPLEX SUBROUTINES:
156 :
157 856 : SUBROUTINE mpi_sum_reduce_complex1(sourceArray, targetArray, mpi_comm)
158 : IMPLICIT NONE
159 : COMPLEX, INTENT(IN) :: sourceArray(:)
160 : COMPLEX, INTENT(INOUT) :: targetArray(:)
161 : INTEGER, INTENT(IN) :: mpi_comm
162 :
163 : INTEGER :: ierr=0
164 : INTEGER :: length
165 :
166 856 : length = SIZE(sourceArray)
167 856 : IF(length.NE.SIZE(targetArray)) CALL judft_error("MPI_REDUCE failed: Array size mismatch.")
168 :
169 : #ifdef CPP_MPI
170 856 : CALL MPI_REDUCE(sourceArray, targetArray, length, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, mpi_comm, ierr)
171 : #else
172 : targetArray(:) = sourceArray(:)
173 : #endif
174 856 : IF (ierr.NE.0) CALL judft_error("MPI_REDUCE failed")
175 856 : END SUBROUTINE mpi_sum_reduce_complex1
176 :
177 696 : SUBROUTINE mpi_sum_reduce_complex2(sourceArray, targetArray, mpi_comm)
178 : IMPLICIT NONE
179 : COMPLEX, INTENT(IN) :: sourceArray(:,:)
180 : COMPLEX, INTENT(INOUT) :: targetArray(:,:)
181 : INTEGER, INTENT(IN) :: mpi_comm
182 :
183 : INTEGER :: ierr=0
184 : INTEGER :: length
185 :
186 2088 : length = SIZE(sourceArray)
187 2088 : IF(length.NE.SIZE(targetArray)) CALL judft_error("MPI_REDUCE failed: Array size mismatch.")
188 :
189 : #ifdef CPP_MPI
190 696 : CALL MPI_REDUCE(sourceArray, targetArray, length, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, mpi_comm, ierr)
191 : #else
192 : targetArray(:,:) = sourceArray(:,:)
193 : #endif
194 696 : IF (ierr.NE.0) CALL judft_error("MPI_REDUCE failed")
195 696 : END SUBROUTINE mpi_sum_reduce_complex2
196 :
197 696 : SUBROUTINE mpi_sum_reduce_complex3(sourceArray, targetArray, mpi_comm)
198 : IMPLICIT NONE
199 : COMPLEX, INTENT(IN) :: sourceArray(:,:,:)
200 : COMPLEX, INTENT(INOUT) :: targetArray(:,:,:)
201 : INTEGER, INTENT(IN) :: mpi_comm
202 :
203 : INTEGER :: ierr=0
204 : INTEGER :: length
205 :
206 2784 : length = SIZE(sourceArray)
207 2784 : IF(length.NE.SIZE(targetArray)) CALL judft_error("MPI_REDUCE failed: Array size mismatch.")
208 :
209 : #ifdef CPP_MPI
210 696 : CALL MPI_REDUCE(sourceArray, targetArray, length, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, mpi_comm, ierr)
211 : #else
212 : targetArray(:,:,:) = sourceArray(:,:,:)
213 : #endif
214 696 : IF (ierr.NE.0) CALL judft_error("MPI_REDUCE failed")
215 696 : END SUBROUTINE mpi_sum_reduce_complex3
216 :
217 : ! LOGICAL SUBROUTINES :
218 :
219 0 : SUBROUTINE mpi_lor_reduce_bool1(sourceArray, targetArray, mpi_comm)
220 : IMPLICIT NONE
221 : LOGICAL, INTENT(IN) :: sourceArray(:)
222 : LOGICAL, INTENT(INOUT) :: targetArray(:)
223 : INTEGER, INTENT(IN) :: mpi_comm
224 :
225 : INTEGER :: ierr=0
226 : INTEGER :: length
227 :
228 0 : length = SIZE(sourceArray)
229 0 : IF(length.NE.SIZE(targetArray)) CALL judft_error("MPI_REDUCE failed: Array size mismatch.")
230 :
231 : #ifdef CPP_MPI
232 0 : CALL MPI_REDUCE(sourceArray, targetArray, length, MPI_LOGICAL, MPI_LOR, 0, mpi_comm, ierr)
233 : #else
234 : targetArray(:) = sourceArray(:)
235 : #endif
236 0 : IF (ierr.NE.0) CALL judft_error("MPI_REDUCE failed")
237 0 : END SUBROUTINE mpi_lor_reduce_bool1
238 :
239 2164 : SUBROUTINE mpi_lor_reduce_bool2(sourceArray, targetArray, mpi_comm)
240 : IMPLICIT NONE
241 : LOGICAL, INTENT(IN) :: sourceArray(:,:)
242 : LOGICAL, INTENT(INOUT) :: targetArray(:,:)
243 : INTEGER, INTENT(IN) :: mpi_comm
244 :
245 : INTEGER :: ierr=0
246 : INTEGER :: length
247 :
248 6492 : length = SIZE(sourceArray)
249 6492 : IF(length.NE.SIZE(targetArray)) CALL judft_error("MPI_REDUCE failed: Array size mismatch.")
250 :
251 : #ifdef CPP_MPI
252 2164 : CALL MPI_REDUCE(sourceArray, targetArray, length, MPI_LOGICAL, MPI_LOR, 0, mpi_comm, ierr)
253 : #else
254 : targetArray(:,:) = sourceArray(:,:)
255 : #endif
256 2164 : IF (ierr.NE.0) CALL judft_error("MPI_REDUCE failed")
257 2164 : END SUBROUTINE mpi_lor_reduce_bool2
258 :
259 0 : SUBROUTINE mpi_lor_reduce_bool3(sourceArray, targetArray, mpi_comm)
260 : IMPLICIT NONE
261 : LOGICAL, INTENT(IN) :: sourceArray(:,:,:)
262 : LOGICAL, INTENT(INOUT) :: targetArray(:,:,:)
263 : INTEGER, INTENT(IN) :: mpi_comm
264 :
265 : INTEGER :: ierr=0
266 : INTEGER :: length
267 :
268 0 : length = SIZE(sourceArray)
269 0 : IF(length.NE.SIZE(targetArray)) CALL judft_error("MPI_REDUCE failed: Array size mismatch.")
270 :
271 : #ifdef CPP_MPI
272 0 : CALL MPI_REDUCE(sourceArray, targetArray, length, MPI_LOGICAL, MPI_LOR, 0, mpi_comm, ierr)
273 : #else
274 : targetArray(:,:,:) = sourceArray(:,:,:)
275 : #endif
276 0 : IF (ierr.NE.0) CALL judft_error("MPI_REDUCE failed")
277 0 : END SUBROUTINE mpi_lor_reduce_bool3
278 :
279 :
280 : END MODULE m_mpi_reduce_tool
|
