(git:374b731)
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-2024 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(__SCALAPACK)
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(__SCALAPACK)
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
82#if defined(__DLAF)
83 CALL cp_dlaf_create_grid(context_handle)
84#endif
85#else
86 mark_used(this)
87 mark_used(comm)
88 mark_used(order)
89 mark_used(nprow)
90 mark_used(npcol)
91#endif
92 CALL this%gridinfo()
93 END SUBROUTINE cp_blacs_gridinit
94
95! **************************************************************************************************
96!> \brief ...
97!> \param this ...
98! **************************************************************************************************
99 SUBROUTINE cp_blacs_gridexit(this)
100 CLASS(cp_blacs_type), INTENT(IN) :: this
101#if defined(__SCALAPACK)
102 CALL blacs_gridexit(this%context_handle)
103
104#if defined(__DLAF)
105 CALL cp_dlaf_free_grid(this%context_handle)
106#endif
107#else
108 mark_used(this)
109#endif
110 END SUBROUTINE cp_blacs_gridexit
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(__SCALAPACK)
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(__SCALAPACK)
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(__SCALAPACK)
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
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(__SCALAPACK)
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
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(__SCALAPACK)
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
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(__SCALAPACK)
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
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(__SCALAPACK)
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
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(__SCALAPACK)
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(__SCALAPACK)
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: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:109
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:142
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