(git:db0abe2)
Loading...
Searching...
No Matches
cp_blacs_types.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief wrappers for the actual blacs calls.
10!> all functionality needed in the code should actually be provide by cp_blacs_env
11!> these functions should be private members of that module
12!> \note
13!> http://www.netlib.org/blacs/BLACS/QRef.html
14!> \par History
15!> 12.2003 created [Joost]
16!> \author Joost VandeVondele
17! **************************************************************************************************
18MODULE cp_blacs_types
19
20 USE kinds, ONLY: dp
21 USE message_passing, ONLY: mp_comm_type
22#include "../base/base_uses.f90"
23
24 IMPLICIT NONE
25 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_blacs_types'
26 PRIVATE
27
28 PUBLIC :: cp_blacs_type, cp_blacs_exit
29
30 TYPE cp_blacs_type
31 PRIVATE
32#if defined(__parallel)
33 INTEGER :: context_handle = -1
34#endif
35 INTEGER, DIMENSION(2), PUBLIC :: mepos = -1, num_pe = -1
36 CONTAINS
37 PROCEDURE, PUBLIC, pass(this), non_overridable :: gridinit => cp_blacs_gridinit
38 PROCEDURE, PUBLIC, pass(this), non_overridable :: gridexit => cp_blacs_gridexit
39 PROCEDURE, PRIVATE, pass(this), non_overridable :: gridinfo => cp_blacs_gridinfo
40 PROCEDURE, PUBLIC, pass(this), non_overridable :: set => cp_blacs_set
41 PROCEDURE, PUBLIC, pass(this), non_overridable :: zgebs2d => cp_blacs_zgebs2d
42 PROCEDURE, PUBLIC, pass(this), non_overridable :: dgebs2d => cp_blacs_dgebs2d
43 PROCEDURE, PUBLIC, pass(this), non_overridable :: zgebr2d => cp_blacs_zgebr2d
44 PROCEDURE, PUBLIC, pass(this), non_overridable :: dgebr2d => cp_blacs_dgebr2d
45 PROCEDURE, PUBLIC, pass(this), non_overridable :: get_handle => cp_blacs_get_handle
46
47 PROCEDURE, PRIVATE, pass(this), non_overridable :: cp_context_is_equal
48 generic, PUBLIC :: OPERATOR(==) => cp_context_is_equal
49
50 PROCEDURE, PRIVATE, pass(this), non_overridable :: cp_context_is_not_equal
51 generic, PUBLIC :: OPERATOR(/=) => cp_context_is_not_equal
52
53 PROCEDURE, PUBLIC, pass(this), non_overridable :: interconnect => cp_blacs_interconnect
54 END TYPE cp_blacs_type
55
56!***
57CONTAINS
58
59! **************************************************************************************************
60!> \brief ...
61!> \param this ...
62!> \param comm ...
63!> \param order ...
64!> \param nprow ...
65!> \param npcol ...
66! **************************************************************************************************
67 SUBROUTINE cp_blacs_gridinit(this, comm, order, nprow, npcol)
68 CLASS(cp_blacs_type), INTENT(OUT) :: this
69 CLASS(mp_comm_type), INTENT(IN) :: comm
70 CHARACTER(len=1), INTENT(IN):: order
71 INTEGER, INTENT(IN) :: nprow, npcol
72#if defined(__parallel)
73 INTEGER :: context_handle
74 context_handle = comm%get_handle()
75 CALL blacs_gridinit(context_handle, order, nprow, npcol)
76 this%context_handle = context_handle
77#else
78 mark_used(this)
79 mark_used(comm)
80 mark_used(order)
81 mark_used(nprow)
82 mark_used(npcol)
83#endif
84 CALL this%gridinfo()
85 END SUBROUTINE cp_blacs_gridinit
86
87! **************************************************************************************************
88!> \brief ...
89!> \param this ...
90! **************************************************************************************************
91 SUBROUTINE cp_blacs_gridexit(this)
92 CLASS(cp_blacs_type), INTENT(IN) :: this
93#if defined(__parallel)
94 CALL blacs_gridexit(this%context_handle)
95#else
96 mark_used(this)
97#endif
98 END SUBROUTINE cp_blacs_gridexit
99
100! **************************************************************************************************
101!> \brief Release all BLACS resources without finalizing MPI
102!> \note BLACS completes its asynchronous sends lazily and the requests of the last sends keep
103!> their communicators alive. Since all BLACS contexts are destroyed, also those of a
104!> calling program, call it only at the very end and only if CP2K owns MPI.
105! **************************************************************************************************
106 SUBROUTINE cp_blacs_exit()
107#if defined(__parallel)
108 CALL blacs_exit(1)
109#endif
110 END SUBROUTINE cp_blacs_exit
111
112! **************************************************************************************************
113!> \brief ...
114!> \param this ...
115! **************************************************************************************************
116 SUBROUTINE cp_blacs_gridinfo(this)
117 CLASS(cp_blacs_type), INTENT(INOUT) :: this
118#if defined(__parallel)
119 CALL blacs_gridinfo(this%context_handle, this%num_pe(1), this%num_pe(2), this%mepos(1), this%mepos(2))
120#else
121 mark_used(this)
122 this%num_pe = 1
123 this%mepos = 0
124#endif
125 END SUBROUTINE cp_blacs_gridinfo
126
127! **************************************************************************************************
128!> \brief ...
129!> \param this ...
130!> \param what :
131!> WHAT = 0 : Handle indicating default system context; ! DO NOT USE (i.e. use para_env)
132!> WHAT = 1 : The BLACS message ID range;
133!> WHAT = 2 : The BLACS debug level the library was compiled with;
134!> WHAT = 10: Handle indicating the system context used to define the BLACS context whose handle is ICONTXT;
135!> WHAT = 11: Number of rings multiring topology is presently using;
136!> WHAT = 12: Number of branches general tree topology is presently using.
137!> WHAT = 15: If non-zero, makes topology choice for repeatable collectives
138!> \param val ...
139! **************************************************************************************************
140 SUBROUTINE cp_blacs_set(this, what, val)
141 CLASS(cp_blacs_type), INTENT(IN) :: this
142 INTEGER, INTENT(IN) :: what, val
143#if defined(__parallel)
144 CALL blacs_set(this%context_handle, what, val)
145#else
146 mark_used(this)
147 mark_used(what)
148 mark_used(val)
149#endif
150 END SUBROUTINE cp_blacs_set
151
152! **************************************************************************************************
153!> \brief ...
154!> \param this ...
155!> \param SCOPE ...
156!> \param TOP ...
157!> \param M ...
158!> \param N ...
159!> \param A ...
160!> \param LDA ...
161! **************************************************************************************************
162 SUBROUTINE cp_blacs_zgebs2d(this, SCOPE, TOP, M, N, A, LDA)
163 CLASS(cp_blacs_type), INTENT(IN) :: this
164 CHARACTER(len=1), INTENT(IN) :: scope, top
165 INTEGER, INTENT(IN) :: m, n, lda
166 COMPLEX(KIND=dp) :: a
167#if defined(__parallel)
168 CALL zgebs2d(this%context_handle, scope, top, m, n, a, lda)
169#else
170 mark_used(this)
171 mark_used(scope)
172 mark_used(top)
173 mark_used(m)
174 mark_used(n)
175 mark_used(a)
176 mark_used(lda)
177#endif
178 END SUBROUTINE cp_blacs_zgebs2d
179! **************************************************************************************************
180!> \brief ...
181!> \param this ...
182!> \param SCOPE ...
183!> \param TOP ...
184!> \param M ...
185!> \param N ...
186!> \param A ...
187!> \param LDA ...
188!> \param RSRC ...
189!> \param CSRC ...
190! **************************************************************************************************
191 SUBROUTINE cp_blacs_zgebr2d(this, SCOPE, TOP, M, N, A, LDA, RSRC, CSRC)
192 CLASS(cp_blacs_type), INTENT(IN) :: this
193 CHARACTER(len=1), INTENT(IN) :: scope, top
194 INTEGER, INTENT(IN) :: m, n, lda
195 INTEGER, INTENT(IN) :: rsrc, csrc
196 COMPLEX(KIND=dp) :: a
197#if defined(__parallel)
198 CALL zgebr2d(this%context_handle, scope, top, m, n, a, lda, rsrc, csrc)
199#else
200 mark_used(this)
201 mark_used(scope)
202 mark_used(top)
203 mark_used(m)
204 mark_used(n)
205 mark_used(a)
206 mark_used(lda)
207 mark_used(rsrc)
208 mark_used(csrc)
209#endif
210 END SUBROUTINE cp_blacs_zgebr2d
211
212! **************************************************************************************************
213!> \brief ...
214!> \param this ...
215!> \param SCOPE ...
216!> \param TOP ...
217!> \param M ...
218!> \param N ...
219!> \param A ...
220!> \param LDA ...
221! **************************************************************************************************
222 SUBROUTINE cp_blacs_dgebs2d(this, SCOPE, TOP, M, N, A, LDA)
223 CLASS(cp_blacs_type), INTENT(IN) :: this
224 CHARACTER(len=1), INTENT(IN) :: scope, top
225 INTEGER, INTENT(IN) :: m, n, lda
226 REAL(kind=dp) :: a
227#if defined(__parallel)
228 CALL dgebs2d(this%context_handle, scope, top, m, n, a, lda)
229#else
230 mark_used(this)
231 mark_used(scope)
232 mark_used(top)
233 mark_used(m)
234 mark_used(n)
235 mark_used(a)
236 mark_used(lda)
237#endif
238 END SUBROUTINE cp_blacs_dgebs2d
239! **************************************************************************************************
240!> \brief ...
241!> \param this ...
242!> \param SCOPE ...
243!> \param TOP ...
244!> \param M ...
245!> \param N ...
246!> \param A ...
247!> \param LDA ...
248!> \param RSRC ...
249!> \param CSRC ...
250! **************************************************************************************************
251 SUBROUTINE cp_blacs_dgebr2d(this, SCOPE, TOP, M, N, A, LDA, RSRC, CSRC)
252 CLASS(cp_blacs_type), INTENT(IN) :: this
253 CHARACTER(len=1), INTENT(IN) :: scope, top
254 INTEGER, INTENT(IN) :: m, n, lda
255 INTEGER, INTENT(IN) :: rsrc, csrc
256 REAL(kind=dp) :: a
257#if defined(__parallel)
258 CALL dgebr2d(this%context_handle, scope, top, m, n, a, lda, rsrc, csrc)
259#else
260 mark_used(this)
261 mark_used(scope)
262 mark_used(top)
263 mark_used(m)
264 mark_used(n)
265 mark_used(a)
266 mark_used(lda)
267 mark_used(rsrc)
268 mark_used(csrc)
269#endif
270 END SUBROUTINE cp_blacs_dgebr2d
271
272! **************************************************************************************************
273!> \brief ...
274!> \param this ...
275!> \return ...
276! **************************************************************************************************
277 ELEMENTAL INTEGER FUNCTION cp_blacs_get_handle(this)
278 CLASS(cp_blacs_type), INTENT(IN) :: this
279#if defined(__parallel)
280 cp_blacs_get_handle = this%context_handle
281#else
282 mark_used(this)
283 cp_blacs_get_handle = -1
284#endif
285 END FUNCTION cp_blacs_get_handle
286
287! **************************************************************************************************
288!> \brief ...
289!> \param this ...
290!> \param other ...
291!> \return ...
292! **************************************************************************************************
293 ELEMENTAL LOGICAL FUNCTION cp_context_is_equal(this, other)
294 CLASS(cp_blacs_type), INTENT(IN) :: this, other
295#if defined(__parallel)
296 cp_context_is_equal = (this%context_handle == other%context_handle)
297#else
298 mark_used(this)
299 mark_used(other)
300 cp_context_is_equal = .true.
301#endif
302 END FUNCTION cp_context_is_equal
303
304! **************************************************************************************************
305!> \brief ...
306!> \param this ...
307!> \param other ...
308!> \return ...
309! **************************************************************************************************
310 ELEMENTAL LOGICAL FUNCTION cp_context_is_not_equal(this, other)
311 CLASS(cp_blacs_type), INTENT(IN) :: this, other
312#if defined(__parallel)
313 cp_context_is_not_equal = (this%context_handle /= other%context_handle)
314#else
315 mark_used(this)
316 mark_used(other)
317 cp_context_is_not_equal = .false.
318#endif
319 END FUNCTION cp_context_is_not_equal
320
321! **************************************************************************************************
322!> \brief ...
323!> \param this ...
324!> \param comm_super ...
325!> \return ...
326! **************************************************************************************************
327 TYPE(mp_comm_type) function cp_blacs_interconnect(this, comm_super)
328 CLASS(cp_blacs_type), INTENT(IN) :: this
329 CLASS(mp_comm_type), INTENT(IN) :: comm_super
330
331 INTEGER :: blacs_coord
332
333! We enumerate the processes within the process grid in a linear fashion
334 blacs_coord = this%mepos(1)*this%num_pe(2) + this%mepos(2)
335
336 CALL cp_blacs_interconnect%from_split(comm_super, blacs_coord)
337
338 END FUNCTION cp_blacs_interconnect
339
340END MODULE cp_blacs_types
cp_blacs_types
wrappers for the actual blacs calls. all functionality needed in the code should actually be provide ...
Definition cp_blacs_types.F:18
cp_blacs_types::cp_blacs_gridinit
subroutine cp_blacs_gridinit(this, comm, order, nprow, npcol)
...
Definition cp_blacs_types.F:68
cp_blacs_types::cp_blacs_exit
subroutine, public cp_blacs_exit()
Release all BLACS resources without finalizing MPI.
Definition cp_blacs_types.F:107
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:27
cp_blacs_types::cp_blacs_type
Definition cp_blacs_types.F:30
message_passing::mp_comm_type
Definition message_passing.F:179