(git:d18deda)
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-2025 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#if defined(__DLAF)
21 USE cp_dlaf_utils_api, ONLY: cp_dlaf_create_grid, &
22 cp_dlaf_free_grid
23#endif
24 USE kinds, ONLY: dp
25 USE message_passing, ONLY: mp_comm_type
26#include "../base/base_uses.f90"
27
28 IMPLICIT NONE
29 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_blacs_types'
30 PRIVATE
31
32 PUBLIC :: cp_blacs_type
33
34 TYPE cp_blacs_type
35 PRIVATE
36#if defined(__parallel)
37 INTEGER :: context_handle = -1
38#endif
39 INTEGER, DIMENSION(2), PUBLIC :: mepos = -1, num_pe = -1
40 CONTAINS
41 PROCEDURE, PUBLIC, pass(this), non_overridable :: gridinit => cp_blacs_gridinit
42 PROCEDURE, PUBLIC, pass(this), non_overridable :: gridexit => cp_blacs_gridexit
43 PROCEDURE, PRIVATE, pass(this), non_overridable :: gridinfo => cp_blacs_gridinfo
44 PROCEDURE, PUBLIC, pass(this), non_overridable :: set => cp_blacs_set
45 PROCEDURE, PUBLIC, pass(this), non_overridable :: zgebs2d => cp_blacs_zgebs2d
46 PROCEDURE, PUBLIC, pass(this), non_overridable :: dgebs2d => cp_blacs_dgebs2d
47 PROCEDURE, PUBLIC, pass(this), non_overridable :: zgebr2d => cp_blacs_zgebr2d
48 PROCEDURE, PUBLIC, pass(this), non_overridable :: dgebr2d => cp_blacs_dgebr2d
49 PROCEDURE, PUBLIC, pass(this), non_overridable :: get_handle => cp_blacs_get_handle
50
51 PROCEDURE, PRIVATE, pass(this), non_overridable :: cp_context_is_equal
52 generic, PUBLIC :: OPERATOR(==) => cp_context_is_equal
53
54 PROCEDURE, PRIVATE, pass(this), non_overridable :: cp_context_is_not_equal
55 generic, PUBLIC :: OPERATOR(/=) => cp_context_is_not_equal
56
57 PROCEDURE, PUBLIC, pass(this), non_overridable :: interconnect => cp_blacs_interconnect
58 END TYPE
59
60!***
61CONTAINS
62
63! **************************************************************************************************
64!> \brief ...
65!> \param this ...
66!> \param comm ...
67!> \param order ...
68!> \param nprow ...
69!> \param npcol ...
70! **************************************************************************************************
71 SUBROUTINE cp_blacs_gridinit(this, comm, order, nprow, npcol)
72 CLASS(cp_blacs_type), INTENT(OUT) :: this
73 CLASS(mp_comm_type), INTENT(IN) :: comm
74 CHARACTER(len=1), INTENT(IN):: order
75 INTEGER, INTENT(IN) :: nprow, npcol
76#if defined(__parallel)
77 INTEGER :: context_handle
78 context_handle = comm%get_handle()
79 CALL blacs_gridinit(context_handle, order, nprow, npcol)
80 this%context_handle = context_handle
81#if defined(__DLAF)
82 CALL cp_dlaf_create_grid(context_handle)
83#endif
84#else
85 mark_used(this)
86 mark_used(comm)
87 mark_used(order)
88 mark_used(nprow)
89 mark_used(npcol)
90#endif
91 CALL this%gridinfo()
92 END SUBROUTINE cp_blacs_gridinit
93
94! **************************************************************************************************
95!> \brief ...
96!> \param this ...
97! **************************************************************************************************
98 SUBROUTINE cp_blacs_gridexit(this)
99 CLASS(cp_blacs_type), INTENT(IN) :: this
100#if defined(__parallel)
101 CALL blacs_gridexit(this%context_handle)
102#if defined(__DLAF)
103 CALL cp_dlaf_free_grid(this%context_handle)
104#endif
105#else
106 mark_used(this)
107#endif
108 END SUBROUTINE cp_blacs_gridexit
109
110! **************************************************************************************************
111!> \brief ...
112!> \param this ...
113! **************************************************************************************************
114 SUBROUTINE cp_blacs_gridinfo(this)
115 CLASS(cp_blacs_type), INTENT(INOUT) :: this
116#if defined(__parallel)
117 CALL blacs_gridinfo(this%context_handle, this%num_pe(1), this%num_pe(2), this%mepos(1), this%mepos(2))
118#else
119 mark_used(this)
120 this%num_pe = 1
121 this%mepos = 0
122#endif
123 END SUBROUTINE cp_blacs_gridinfo
124
125! **************************************************************************************************
126!> \brief ...
127!> \param this ...
128!> \param what :
129!> WHAT = 0 : Handle indicating default system context; ! DO NOT USE (i.e. use para_env)
130!> WHAT = 1 : The BLACS message ID range;
131!> WHAT = 2 : The BLACS debug level the library was compiled with;
132!> WHAT = 10: Handle indicating the system context used to define the BLACS context whose handle is ICONTXT;
133!> WHAT = 11: Number of rings multiring topology is presently using;
134!> WHAT = 12: Number of branches general tree topology is presently using.
135!> WHAT = 15: If non-zero, makes topology choice for repeatable collectives
136!> \param val ...
137! **************************************************************************************************
138 SUBROUTINE cp_blacs_set(this, what, val)
139 CLASS(cp_blacs_type), INTENT(IN) :: this
140 INTEGER, INTENT(IN) :: what, val
141#if defined(__parallel)
142 CALL blacs_set(this%context_handle, what, val)
143#else
144 mark_used(this)
145 mark_used(what)
146 mark_used(val)
147#endif
148 END SUBROUTINE cp_blacs_set
149
150! **************************************************************************************************
151!> \brief ...
152!> \param this ...
153!> \param SCOPE ...
154!> \param TOP ...
155!> \param M ...
156!> \param N ...
157!> \param A ...
158!> \param LDA ...
159! **************************************************************************************************
160 SUBROUTINE cp_blacs_zgebs2d(this, SCOPE, TOP, M, N, A, LDA)
161 CLASS(cp_blacs_type), INTENT(IN) :: this
162 CHARACTER(len=1), INTENT(IN) :: SCOPE, TOP
163 INTEGER, INTENT(IN) :: M, N, LDA
164 COMPLEX(KIND=dp) :: A
165#if defined(__parallel)
166 CALL zgebs2d(this%context_handle, scope, top, m, n, a, lda)
167#else
168 mark_used(this)
169 mark_used(scope)
170 mark_used(top)
171 mark_used(m)
172 mark_used(n)
173 mark_used(a)
174 mark_used(lda)
175#endif
176 END SUBROUTINE
177! **************************************************************************************************
178!> \brief ...
179!> \param this ...
180!> \param SCOPE ...
181!> \param TOP ...
182!> \param M ...
183!> \param N ...
184!> \param A ...
185!> \param LDA ...
186!> \param RSRC ...
187!> \param CSRC ...
188! **************************************************************************************************
189 SUBROUTINE cp_blacs_zgebr2d(this, SCOPE, TOP, M, N, A, LDA, RSRC, CSRC)
190 CLASS(cp_blacs_type), INTENT(IN) :: this
191 CHARACTER(len=1), INTENT(IN) :: SCOPE, TOP
192 INTEGER, INTENT(IN) :: M, N, LDA
193 INTEGER, INTENT(IN) :: RSRC, CSRC
194 COMPLEX(KIND=dp) :: A
195#if defined(__parallel)
196 CALL zgebr2d(this%context_handle, scope, top, m, n, a, lda, rsrc, csrc)
197#else
198 mark_used(this)
199 mark_used(scope)
200 mark_used(top)
201 mark_used(m)
202 mark_used(n)
203 mark_used(a)
204 mark_used(lda)
205 mark_used(rsrc)
206 mark_used(csrc)
207#endif
208 END SUBROUTINE
209
210! **************************************************************************************************
211!> \brief ...
212!> \param this ...
213!> \param SCOPE ...
214!> \param TOP ...
215!> \param M ...
216!> \param N ...
217!> \param A ...
218!> \param LDA ...
219! **************************************************************************************************
220 SUBROUTINE cp_blacs_dgebs2d(this, SCOPE, TOP, M, N, A, LDA)
221 CLASS(cp_blacs_type), INTENT(IN) :: this
222 CHARACTER(len=1), INTENT(IN) :: SCOPE, TOP
223 INTEGER, INTENT(IN) :: M, N, LDA
224 REAL(KIND=dp) :: a
225#if defined(__parallel)
226 CALL dgebs2d(this%context_handle, scope, top, m, n, a, lda)
227#else
228 mark_used(this)
229 mark_used(scope)
230 mark_used(top)
231 mark_used(m)
232 mark_used(n)
233 mark_used(a)
234 mark_used(lda)
235#endif
236 END SUBROUTINE
237! **************************************************************************************************
238!> \brief ...
239!> \param this ...
240!> \param SCOPE ...
241!> \param TOP ...
242!> \param M ...
243!> \param N ...
244!> \param A ...
245!> \param LDA ...
246!> \param RSRC ...
247!> \param CSRC ...
248! **************************************************************************************************
249 SUBROUTINE cp_blacs_dgebr2d(this, SCOPE, TOP, M, N, A, LDA, RSRC, CSRC)
250 CLASS(cp_blacs_type), INTENT(IN) :: this
251 CHARACTER(len=1), INTENT(IN) :: scope, top
252 INTEGER, INTENT(IN) :: m, n, lda
253 INTEGER, INTENT(IN) :: rsrc, csrc
254 REAL(kind=dp) :: a
255#if defined(__parallel)
256 CALL dgebr2d(this%context_handle, scope, top, m, n, a, lda, rsrc, csrc)
257#else
258 mark_used(this)
259 mark_used(scope)
260 mark_used(top)
261 mark_used(m)
262 mark_used(n)
263 mark_used(a)
264 mark_used(lda)
265 mark_used(rsrc)
266 mark_used(csrc)
267#endif
268 END SUBROUTINE
269
270! **************************************************************************************************
271!> \brief ...
272!> \param this ...
273!> \return ...
274! **************************************************************************************************
275 ELEMENTAL INTEGER FUNCTION cp_blacs_get_handle(this)
276 CLASS(cp_blacs_type), INTENT(IN) :: this
277#if defined(__parallel)
278 cp_blacs_get_handle = this%context_handle
279#else
280 mark_used(this)
281 cp_blacs_get_handle = -1
282#endif
283 END FUNCTION
284
285! **************************************************************************************************
286!> \brief ...
287!> \param this ...
288!> \param other ...
289!> \return ...
290! **************************************************************************************************
291 ELEMENTAL LOGICAL FUNCTION cp_context_is_equal(this, other)
292 CLASS(cp_blacs_type), INTENT(IN) :: this, other
293#if defined(__parallel)
294 cp_context_is_equal = (this%context_handle == other%context_handle)
295#else
296 mark_used(this)
297 mark_used(other)
298 cp_context_is_equal = .true.
299#endif
300 END FUNCTION cp_context_is_equal
301
302! **************************************************************************************************
303!> \brief ...
304!> \param this ...
305!> \param other ...
306!> \return ...
307! **************************************************************************************************
308 ELEMENTAL LOGICAL FUNCTION cp_context_is_not_equal(this, other)
309 CLASS(cp_blacs_type), INTENT(IN) :: this, other
310#if defined(__parallel)
311 cp_context_is_not_equal = (this%context_handle /= other%context_handle)
312#else
313 mark_used(this)
314 mark_used(other)
315 cp_context_is_not_equal = .false.
316#endif
317 END FUNCTION cp_context_is_not_equal
318
319! **************************************************************************************************
320!> \brief ...
321!> \param this ...
322!> \param comm_super ...
323!> \return ...
324! **************************************************************************************************
325 TYPE(mp_comm_type) FUNCTION cp_blacs_interconnect(this, comm_super)
326 CLASS(cp_blacs_type), INTENT(IN) :: this
327 CLASS(mp_comm_type), INTENT(IN) :: comm_super
328
329 INTEGER :: blacs_coord
330
331! We enumerate the processes within the process grid in a linear fashion
332 blacs_coord = this%mepos(1)*this%num_pe(2) + this%mepos(2)
333
334 CALL cp_blacs_interconnect%from_split(comm_super, blacs_coord)
335
336 END FUNCTION cp_blacs_interconnect
337
338END 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:72
cp_dlaf_utils_api
Definition cp_dlaf_utils_api.F:8
cp_dlaf_utils_api::cp_dlaf_create_grid
subroutine, public cp_dlaf_create_grid(blacs_context)
Create DLA-Future grid from BLACS context.
Definition cp_dlaf_utils_api.F:74
cp_dlaf_utils_api::cp_dlaf_free_grid
subroutine, public cp_dlaf_free_grid(blacs_context)
Free DLA-Future grid corresponding to BLACS context.
Definition cp_dlaf_utils_api.F:98
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:23
cp_blacs_types::cp_blacs_type
Definition cp_blacs_types.F:34
message_passing::mp_comm_type
Definition message_passing.F:189