Line data Source code
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 : ! **************************************************************************************************
18 : MODULE 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
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
55 :
56 : !***
57 : CONTAINS
58 :
59 : ! **************************************************************************************************
60 : !> \brief ...
61 : !> \param this ...
62 : !> \param comm ...
63 : !> \param order ...
64 : !> \param nprow ...
65 : !> \param npcol ...
66 : ! **************************************************************************************************
67 179510 : 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 179510 : context_handle = comm%get_handle()
75 179510 : CALL blacs_gridinit(context_handle, order, nprow, npcol)
76 179510 : 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 179510 : CALL this%gridinfo()
85 179510 : END SUBROUTINE cp_blacs_gridinit
86 :
87 : ! **************************************************************************************************
88 : !> \brief ...
89 : !> \param this ...
90 : ! **************************************************************************************************
91 179510 : SUBROUTINE cp_blacs_gridexit(this)
92 : CLASS(cp_blacs_type), INTENT(IN) :: this
93 : #if defined(__parallel)
94 179510 : CALL blacs_gridexit(this%context_handle)
95 : #else
96 : MARK_USED(this)
97 : #endif
98 179510 : END SUBROUTINE cp_blacs_gridexit
99 :
100 : ! **************************************************************************************************
101 : !> \brief ...
102 : !> \param this ...
103 : ! **************************************************************************************************
104 179510 : SUBROUTINE cp_blacs_gridinfo(this)
105 : CLASS(cp_blacs_type), INTENT(INOUT) :: this
106 : #if defined(__parallel)
107 179510 : CALL blacs_gridinfo(this%context_handle, this%num_pe(1), this%num_pe(2), this%mepos(1), this%mepos(2))
108 : #else
109 : MARK_USED(this)
110 : this%num_pe = 1
111 : this%mepos = 0
112 : #endif
113 179510 : END SUBROUTINE cp_blacs_gridinfo
114 :
115 : ! **************************************************************************************************
116 : !> \brief ...
117 : !> \param this ...
118 : !> \param what :
119 : !> WHAT = 0 : Handle indicating default system context; ! DO NOT USE (i.e. use para_env)
120 : !> WHAT = 1 : The BLACS message ID range;
121 : !> WHAT = 2 : The BLACS debug level the library was compiled with;
122 : !> WHAT = 10: Handle indicating the system context used to define the BLACS context whose handle is ICONTXT;
123 : !> WHAT = 11: Number of rings multiring topology is presently using;
124 : !> WHAT = 12: Number of branches general tree topology is presently using.
125 : !> WHAT = 15: If non-zero, makes topology choice for repeatable collectives
126 : !> \param val ...
127 : ! **************************************************************************************************
128 802 : SUBROUTINE cp_blacs_set(this, what, val)
129 : CLASS(cp_blacs_type), INTENT(IN) :: this
130 : INTEGER, INTENT(IN) :: what, val
131 : #if defined(__parallel)
132 802 : CALL blacs_set(this%context_handle, what, val)
133 : #else
134 : MARK_USED(this)
135 : MARK_USED(what)
136 : MARK_USED(val)
137 : #endif
138 802 : END SUBROUTINE cp_blacs_set
139 :
140 : ! **************************************************************************************************
141 : !> \brief ...
142 : !> \param this ...
143 : !> \param SCOPE ...
144 : !> \param TOP ...
145 : !> \param M ...
146 : !> \param N ...
147 : !> \param A ...
148 : !> \param LDA ...
149 : ! **************************************************************************************************
150 4641 : SUBROUTINE cp_blacs_zgebs2d(this, SCOPE, TOP, M, N, A, LDA)
151 : CLASS(cp_blacs_type), INTENT(IN) :: this
152 : CHARACTER(len=1), INTENT(IN) :: SCOPE, TOP
153 : INTEGER, INTENT(IN) :: M, N, LDA
154 : COMPLEX(KIND=dp) :: A
155 : #if defined(__parallel)
156 4641 : CALL zgebs2d(this%context_handle, SCOPE, TOP, M, N, A, LDA)
157 : #else
158 : MARK_USED(this)
159 : MARK_USED(SCOPE)
160 : MARK_USED(TOP)
161 : MARK_USED(M)
162 : MARK_USED(N)
163 : MARK_USED(A)
164 : MARK_USED(LDA)
165 : #endif
166 4641 : END SUBROUTINE
167 : ! **************************************************************************************************
168 : !> \brief ...
169 : !> \param this ...
170 : !> \param SCOPE ...
171 : !> \param TOP ...
172 : !> \param M ...
173 : !> \param N ...
174 : !> \param A ...
175 : !> \param LDA ...
176 : !> \param RSRC ...
177 : !> \param CSRC ...
178 : ! **************************************************************************************************
179 4641 : SUBROUTINE cp_blacs_zgebr2d(this, SCOPE, TOP, M, N, A, LDA, RSRC, CSRC)
180 : CLASS(cp_blacs_type), INTENT(IN) :: this
181 : CHARACTER(len=1), INTENT(IN) :: SCOPE, TOP
182 : INTEGER, INTENT(IN) :: M, N, LDA
183 : INTEGER, INTENT(IN) :: RSRC, CSRC
184 : COMPLEX(KIND=dp) :: A
185 : #if defined(__parallel)
186 4641 : CALL zgebr2d(this%context_handle, SCOPE, TOP, M, N, A, LDA, RSRC, CSRC)
187 : #else
188 : MARK_USED(this)
189 : MARK_USED(SCOPE)
190 : MARK_USED(TOP)
191 : MARK_USED(M)
192 : MARK_USED(N)
193 : MARK_USED(A)
194 : MARK_USED(LDA)
195 : MARK_USED(RSRC)
196 : MARK_USED(CSRC)
197 : #endif
198 4641 : END SUBROUTINE
199 :
200 : ! **************************************************************************************************
201 : !> \brief ...
202 : !> \param this ...
203 : !> \param SCOPE ...
204 : !> \param TOP ...
205 : !> \param M ...
206 : !> \param N ...
207 : !> \param A ...
208 : !> \param LDA ...
209 : ! **************************************************************************************************
210 1252161 : SUBROUTINE cp_blacs_dgebs2d(this, SCOPE, TOP, M, N, A, LDA)
211 : CLASS(cp_blacs_type), INTENT(IN) :: this
212 : CHARACTER(len=1), INTENT(IN) :: SCOPE, TOP
213 : INTEGER, INTENT(IN) :: M, N, LDA
214 : REAL(KIND=dp) :: A
215 : #if defined(__parallel)
216 1252161 : CALL dgebs2d(this%context_handle, SCOPE, TOP, M, N, A, LDA)
217 : #else
218 : MARK_USED(this)
219 : MARK_USED(SCOPE)
220 : MARK_USED(TOP)
221 : MARK_USED(M)
222 : MARK_USED(N)
223 : MARK_USED(A)
224 : MARK_USED(LDA)
225 : #endif
226 1252161 : END SUBROUTINE
227 : ! **************************************************************************************************
228 : !> \brief ...
229 : !> \param this ...
230 : !> \param SCOPE ...
231 : !> \param TOP ...
232 : !> \param M ...
233 : !> \param N ...
234 : !> \param A ...
235 : !> \param LDA ...
236 : !> \param RSRC ...
237 : !> \param CSRC ...
238 : ! **************************************************************************************************
239 1252161 : SUBROUTINE cp_blacs_dgebr2d(this, SCOPE, TOP, M, N, A, LDA, RSRC, CSRC)
240 : CLASS(cp_blacs_type), INTENT(IN) :: this
241 : CHARACTER(len=1), INTENT(IN) :: SCOPE, TOP
242 : INTEGER, INTENT(IN) :: M, N, LDA
243 : INTEGER, INTENT(IN) :: RSRC, CSRC
244 : REAL(KIND=dp) :: A
245 : #if defined(__parallel)
246 1252161 : CALL dgebr2d(this%context_handle, SCOPE, TOP, M, N, A, LDA, RSRC, CSRC)
247 : #else
248 : MARK_USED(this)
249 : MARK_USED(SCOPE)
250 : MARK_USED(TOP)
251 : MARK_USED(M)
252 : MARK_USED(N)
253 : MARK_USED(A)
254 : MARK_USED(LDA)
255 : MARK_USED(RSRC)
256 : MARK_USED(CSRC)
257 : #endif
258 1252161 : END SUBROUTINE
259 :
260 : ! **************************************************************************************************
261 : !> \brief ...
262 : !> \param this ...
263 : !> \return ...
264 : ! **************************************************************************************************
265 172936 : ELEMENTAL INTEGER FUNCTION cp_blacs_get_handle(this)
266 : CLASS(cp_blacs_type), INTENT(IN) :: this
267 : #if defined(__parallel)
268 172936 : cp_blacs_get_handle = this%context_handle
269 : #else
270 : MARK_USED(this)
271 : cp_blacs_get_handle = -1
272 : #endif
273 172936 : END FUNCTION
274 :
275 : ! **************************************************************************************************
276 : !> \brief ...
277 : !> \param this ...
278 : !> \param other ...
279 : !> \return ...
280 : ! **************************************************************************************************
281 482819 : ELEMENTAL LOGICAL FUNCTION cp_context_is_equal(this, other)
282 : CLASS(cp_blacs_type), INTENT(IN) :: this, other
283 : #if defined(__parallel)
284 482819 : cp_context_is_equal = (this%context_handle == other%context_handle)
285 : #else
286 : MARK_USED(this)
287 : MARK_USED(other)
288 : cp_context_is_equal = .TRUE.
289 : #endif
290 482819 : END FUNCTION cp_context_is_equal
291 :
292 : ! **************************************************************************************************
293 : !> \brief ...
294 : !> \param this ...
295 : !> \param other ...
296 : !> \return ...
297 : ! **************************************************************************************************
298 1415672 : ELEMENTAL LOGICAL FUNCTION cp_context_is_not_equal(this, other)
299 : CLASS(cp_blacs_type), INTENT(IN) :: this, other
300 : #if defined(__parallel)
301 1415672 : cp_context_is_not_equal = (this%context_handle /= other%context_handle)
302 : #else
303 : MARK_USED(this)
304 : MARK_USED(other)
305 : cp_context_is_not_equal = .FALSE.
306 : #endif
307 1415672 : END FUNCTION cp_context_is_not_equal
308 :
309 : ! **************************************************************************************************
310 : !> \brief ...
311 : !> \param this ...
312 : !> \param comm_super ...
313 : !> \return ...
314 : ! **************************************************************************************************
315 958 : TYPE(mp_comm_type) FUNCTION cp_blacs_interconnect(this, comm_super)
316 : CLASS(cp_blacs_type), INTENT(IN) :: this
317 : CLASS(mp_comm_type), INTENT(IN) :: comm_super
318 :
319 : INTEGER :: blacs_coord
320 :
321 : ! We enumerate the processes within the process grid in a linear fashion
322 958 : blacs_coord = this%mepos(1)*this%num_pe(2) + this%mepos(2)
323 :
324 958 : CALL cp_blacs_interconnect%from_split(comm_super, blacs_coord)
325 :
326 958 : END FUNCTION cp_blacs_interconnect
327 :
328 0 : END MODULE cp_blacs_types
|
