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 methods related to the blacs parallel environment
10 : !> \par History
11 : !> 08.2002 created [fawzi]
12 : !> 02.2004 modified to associate a blacs_env with a given para_env
13 : !> \author Fawzi Mohamed
14 : ! **************************************************************************************************
15 : MODULE cp_blacs_env
16 : USE cp_array_utils, ONLY: cp_2d_i_write
17 : USE cp_blacs_types, ONLY: cp_blacs_type
18 : USE kinds, ONLY: dp
19 : USE machine, ONLY: m_flush
20 : USE mathlib, ONLY: gcd
21 : USE message_passing, ONLY: mp_para_env_release,&
22 : mp_para_env_type
23 : #include "../base/base_uses.f90"
24 :
25 : IMPLICIT NONE
26 : PRIVATE
27 :
28 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
29 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_blacs_env'
30 :
31 : ! Blacs type of distribution
32 : INTEGER, PARAMETER, PUBLIC :: BLACS_GRID_SQUARE = 1, &
33 : BLACS_GRID_ROW = 2, &
34 : BLACS_GRID_COL = 3
35 :
36 : PUBLIC :: cp_blacs_env_type
37 : PUBLIC :: cp_blacs_env_create, cp_blacs_env_release
38 :
39 : ! **************************************************************************************************
40 : !> \brief represent a blacs multidimensional parallel environment
41 : !> (for the mpi corrispective see cp_paratypes/mp_para_cart_type)
42 : !> \param ref_count the reference count, when it is zero this object gets
43 : !> deallocated
44 : !> \param my_pid process id of the actual processor
45 : !> \param n_pid number of process ids
46 : !> \param the para_env associated (and compatible) with this blacs_env
47 : !> \param blacs2mpi: maps mepos(1)-mepos(2) of blacs to its mpi rank
48 : !> \param mpi2blacs(i,rank): maps the mpi rank to the mepos(i)
49 : !> \par History
50 : !> 08.2002 created [fawzi]
51 : !> \author Fawzi Mohamed
52 : ! **************************************************************************************************
53 : TYPE, EXTENDS(cp_blacs_type) :: cp_blacs_env_type
54 : INTEGER :: my_pid = -1, n_pid = -1, ref_count = -1
55 : TYPE(mp_para_env_type), POINTER :: para_env => NULL()
56 : INTEGER, DIMENSION(:, :), POINTER :: blacs2mpi => NULL()
57 : INTEGER, DIMENSION(:, :), POINTER :: mpi2blacs => NULL()
58 : LOGICAL :: repeatable = .FALSE.
59 : CONTAINS
60 : PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: create => cp_blacs_env_create_low
61 : PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: retain => cp_blacs_env_retain
62 : PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: release => cp_blacs_env_release_low
63 : PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: get => get_blacs_info
64 : PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: write => cp_blacs_env_write
65 : END TYPE cp_blacs_env_type
66 :
67 : !***
68 : CONTAINS
69 :
70 : ! **************************************************************************************************
71 : !> \brief Return informations about the specified BLACS context.
72 : !> \param blacs_env ...
73 : !> \param my_process_row ...
74 : !> \param my_process_column ...
75 : !> \param my_process_number ...
76 : !> \param number_of_process_rows ...
77 : !> \param number_of_process_columns ...
78 : !> \param number_of_processes ...
79 : !> \param para_env ...
80 : !> \param blacs2mpi ...
81 : !> \param mpi2blacs ...
82 : !> \date 19.06.2001
83 : !> \par History
84 : !> MM.YYYY moved here from qs_blacs (Joost VandeVondele)
85 : !> \author Matthias Krack
86 : !> \version 1.0
87 : ! **************************************************************************************************
88 31075215 : SUBROUTINE get_blacs_info(blacs_env, my_process_row, my_process_column, &
89 : my_process_number, number_of_process_rows, &
90 : number_of_process_columns, number_of_processes, &
91 : para_env, blacs2mpi, mpi2blacs)
92 : CLASS(cp_blacs_env_type), INTENT(IN) :: blacs_env
93 : INTEGER, INTENT(OUT), OPTIONAL :: my_process_row, my_process_column, my_process_number, &
94 : number_of_process_rows, number_of_process_columns, number_of_processes
95 : TYPE(mp_para_env_type), OPTIONAL, POINTER :: para_env
96 : INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: blacs2mpi, mpi2blacs
97 :
98 31075215 : IF (PRESENT(my_process_row)) my_process_row = blacs_env%mepos(1)
99 31075215 : IF (PRESENT(my_process_column)) my_process_column = blacs_env%mepos(2)
100 31075215 : IF (PRESENT(my_process_number)) my_process_number = blacs_env%my_pid
101 31075215 : IF (PRESENT(number_of_process_rows)) number_of_process_rows = blacs_env%num_pe(1)
102 31075215 : IF (PRESENT(number_of_process_columns)) number_of_process_columns = blacs_env%num_pe(2)
103 31075215 : IF (PRESENT(number_of_processes)) number_of_processes = blacs_env%n_pid
104 31075215 : IF (PRESENT(para_env)) para_env => blacs_env%para_env
105 31075215 : IF (PRESENT(blacs2mpi)) blacs2mpi => blacs_env%blacs2mpi
106 31075215 : IF (PRESENT(mpi2blacs)) mpi2blacs => blacs_env%mpi2blacs
107 :
108 31075215 : END SUBROUTINE get_blacs_info
109 :
110 : ! **************************************************************************************************
111 : !> \brief allocates and initializes a type that represent a blacs context
112 : !> \param blacs_env the type to initialize
113 : !> \param para_env the para_env for which a blacs env should be created
114 : !> \param blacs_grid_layout ...
115 : !> \param blacs_repeatable ...
116 : !> \param row_major ...
117 : !> \param grid_2d ...
118 : !> \par History
119 : !> 08.2002 created [fawzi]
120 : !> \author Fawzi Mohamed
121 : ! **************************************************************************************************
122 98496 : SUBROUTINE cp_blacs_env_create(blacs_env, para_env, blacs_grid_layout, blacs_repeatable, row_major, grid_2d)
123 : TYPE(cp_blacs_env_type), INTENT(OUT), POINTER :: blacs_env
124 : TYPE(mp_para_env_type), INTENT(INOUT), TARGET :: para_env
125 : INTEGER, INTENT(IN), OPTIONAL :: blacs_grid_layout
126 : LOGICAL, INTENT(IN), OPTIONAL :: blacs_repeatable, row_major
127 : INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: grid_2d
128 :
129 689472 : ALLOCATE (blacs_env)
130 195020 : CALL blacs_env%create(para_env, blacs_grid_layout, blacs_repeatable, row_major, grid_2d)
131 :
132 98496 : END SUBROUTINE cp_blacs_env_create
133 :
134 : ! **************************************************************************************************
135 : !> \brief allocates and initializes a type that represent a blacs context
136 : !> \param blacs_env the type to initialize
137 : !> \param para_env the para_env for which a blacs env should be created
138 : !> \param blacs_grid_layout ...
139 : !> \param blacs_repeatable ...
140 : !> \param row_major ...
141 : !> \param grid_2d ...
142 : !> \par History
143 : !> 08.2002 created [fawzi]
144 : !> \author Fawzi Mohamed
145 : ! **************************************************************************************************
146 98496 : SUBROUTINE cp_blacs_env_create_low(blacs_env, para_env, blacs_grid_layout, blacs_repeatable, row_major, grid_2d)
147 : CLASS(cp_blacs_env_type), INTENT(OUT) :: blacs_env
148 : TYPE(mp_para_env_type), TARGET, INTENT(INOUT) :: para_env
149 : INTEGER, INTENT(IN), OPTIONAL :: blacs_grid_layout
150 : LOGICAL, INTENT(IN), OPTIONAL :: blacs_repeatable, row_major
151 : INTEGER, DIMENSION(:), INTENT(IN), &
152 : OPTIONAL :: grid_2d
153 :
154 : INTEGER :: ipcol, iprow
155 : #if defined(__parallel)
156 : INTEGER :: gcd_max, ipe, jpe, &
157 : my_blacs_grid_layout, &
158 : npcol, npe, nprow
159 : LOGICAL :: my_blacs_repeatable, &
160 : my_row_major
161 : #endif
162 :
163 : #ifdef __parallel
164 : ! get the number of cpus for this blacs grid
165 98496 : nprow = 1
166 98496 : npcol = 1
167 98496 : npe = para_env%num_pe
168 : ! get the layout of this grid
169 :
170 98496 : IF (PRESENT(grid_2d)) THEN
171 1972 : nprow = grid_2d(1)
172 1972 : npcol = grid_2d(2)
173 : END IF
174 :
175 98496 : IF (nprow*npcol /= npe) THEN
176 : ! hard code for the time being the grid layout
177 9928 : my_blacs_grid_layout = BLACS_GRID_SQUARE
178 9928 : IF (PRESENT(blacs_grid_layout)) my_blacs_grid_layout = blacs_grid_layout
179 : ! XXXXXX
180 9928 : SELECT CASE (my_blacs_grid_layout)
181 : CASE (BLACS_GRID_SQUARE)
182 : ! make the grid as 'square' as possible, where square is defined as nprow and npcol
183 : ! having the largest possible gcd
184 9928 : gcd_max = -1
185 29784 : DO ipe = 1, CEILING(SQRT(REAL(npe, dp)))
186 19856 : jpe = npe/ipe
187 19856 : IF (ipe*jpe /= npe) CYCLE
188 29784 : IF (gcd(ipe, jpe) >= gcd_max) THEN
189 19856 : nprow = ipe
190 19856 : npcol = jpe
191 19856 : gcd_max = gcd(ipe, jpe)
192 : END IF
193 : END DO
194 : CASE (BLACS_GRID_ROW)
195 0 : nprow = 1
196 0 : npcol = npe
197 : CASE (BLACS_GRID_COL)
198 0 : nprow = npe
199 8798 : npcol = 1
200 : END SELECT
201 : END IF
202 :
203 98496 : my_row_major = .TRUE.
204 98496 : IF (PRESENT(row_major)) my_row_major = row_major
205 20 : IF (my_row_major) THEN
206 98496 : CALL blacs_env%gridinit(para_env, "Row-major", nprow, npcol)
207 : ELSE
208 0 : CALL blacs_env%gridinit(para_env, "Col-major", nprow, npcol)
209 : END IF
210 :
211 : ! We set the components of blacs_env here such that we can still use INTENT(OUT) with gridinit
212 98496 : blacs_env%my_pid = para_env%mepos
213 98496 : blacs_env%n_pid = para_env%num_pe
214 98496 : blacs_env%ref_count = 1
215 :
216 98496 : my_blacs_repeatable = .FALSE.
217 98496 : IF (PRESENT(blacs_repeatable)) my_blacs_repeatable = blacs_repeatable
218 98496 : blacs_env%repeatable = my_blacs_repeatable
219 98496 : IF (blacs_env%repeatable) CALL blacs_env%set(15, 1)
220 :
221 : #else
222 : ! In serial mode, we just have to setup the object
223 : CALL blacs_env%gridinit(para_env, "Row-major", 1, 1)
224 :
225 : blacs_env%ref_count = 1
226 : blacs_env%my_pid = 0
227 : blacs_env%n_pid = 1
228 : MARK_USED(blacs_grid_layout)
229 : MARK_USED(blacs_repeatable)
230 : MARK_USED(grid_2d)
231 : MARK_USED(row_major)
232 : #endif
233 :
234 98496 : CALL para_env%retain()
235 98496 : blacs_env%para_env => para_env
236 :
237 : ! generate the mappings blacs2mpi and mpi2blacs
238 393984 : ALLOCATE (blacs_env%blacs2mpi(0:blacs_env%num_pe(1) - 1, 0:blacs_env%num_pe(2) - 1))
239 306662 : blacs_env%blacs2mpi = 0
240 98496 : blacs_env%blacs2mpi(blacs_env%mepos(1), blacs_env%mepos(2)) = para_env%mepos
241 514828 : CALL para_env%sum(blacs_env%blacs2mpi)
242 295488 : ALLOCATE (blacs_env%mpi2blacs(2, 0:para_env%num_pe - 1))
243 427164 : blacs_env%mpi2blacs = -1
244 197106 : DO ipcol = 0, blacs_env%num_pe(2) - 1
245 306662 : DO iprow = 0, blacs_env%num_pe(1) - 1
246 109556 : blacs_env%mpi2blacs(1, blacs_env%blacs2mpi(iprow, ipcol)) = iprow
247 208166 : blacs_env%mpi2blacs(2, blacs_env%blacs2mpi(iprow, ipcol)) = ipcol
248 : END DO
249 : END DO
250 98496 : END SUBROUTINE cp_blacs_env_create_low
251 :
252 : ! **************************************************************************************************
253 : !> \brief retains the given blacs env
254 : !> \param blacs_env the blacs env to retain
255 : !> \par History
256 : !> 08.2002 created [fawzi]
257 : !> \author Fawzi Mohamed
258 : ! **************************************************************************************************
259 535144 : SUBROUTINE cp_blacs_env_retain(blacs_env)
260 : CLASS(cp_blacs_env_type), INTENT(INOUT) :: blacs_env
261 :
262 535144 : CPASSERT(blacs_env%ref_count > 0)
263 535144 : blacs_env%ref_count = blacs_env%ref_count + 1
264 535144 : END SUBROUTINE cp_blacs_env_retain
265 :
266 : ! **************************************************************************************************
267 : !> \brief releases the given blacs_env
268 : !> \param blacs_env the blacs env to release
269 : !> \par History
270 : !> 08.2002 created [fawzi]
271 : !> \author Fawzi Mohamed
272 : ! **************************************************************************************************
273 655780 : SUBROUTINE cp_blacs_env_release(blacs_env)
274 : TYPE(cp_blacs_env_type), POINTER :: blacs_env
275 :
276 655780 : IF (ASSOCIATED(blacs_env)) THEN
277 633640 : CPASSERT(blacs_env%ref_count > 0)
278 633640 : blacs_env%ref_count = blacs_env%ref_count - 1
279 633640 : IF (blacs_env%ref_count < 1) THEN
280 98496 : CALL blacs_env%release()
281 98496 : DEALLOCATE (blacs_env)
282 : END IF
283 : END IF
284 655780 : NULLIFY (blacs_env)
285 655780 : END SUBROUTINE cp_blacs_env_release
286 :
287 : ! **************************************************************************************************
288 : !> \brief releases the given blacs_env
289 : !> \param blacs_env the blacs env to release
290 : !> \par History
291 : !> 08.2002 created [fawzi]
292 : !> \author Fawzi Mohamed
293 : ! **************************************************************************************************
294 98496 : SUBROUTINE cp_blacs_env_release_low(blacs_env)
295 : CLASS(cp_blacs_env_type), INTENT(INOUT) :: blacs_env
296 :
297 98496 : CALL blacs_env%gridexit()
298 98496 : CALL mp_para_env_release(blacs_env%para_env)
299 98496 : DEALLOCATE (blacs_env%mpi2blacs)
300 98496 : DEALLOCATE (blacs_env%blacs2mpi)
301 :
302 98496 : END SUBROUTINE cp_blacs_env_release_low
303 :
304 : ! **************************************************************************************************
305 : !> \brief writes the description of the given blacs env
306 : !> \param blacs_env the blacs environment to write
307 : !> \param unit_nr the unit number where to write the description of the
308 : !> blacs environment
309 : !> \par History
310 : !> 08.2002 created [fawzi]
311 : !> \author Fawzi Mohamed
312 : ! **************************************************************************************************
313 70 : SUBROUTINE cp_blacs_env_write(blacs_env, unit_nr)
314 : CLASS(cp_blacs_env_type), INTENT(IN) :: blacs_env
315 : INTEGER, INTENT(in) :: unit_nr
316 :
317 : WRITE (unit=unit_nr, fmt="(' group=',i10,', ref_count=',i10,',')") &
318 70 : blacs_env%get_handle(), blacs_env%ref_count
319 : WRITE (unit=unit_nr, fmt="(' mepos=(',i8,',',i8,'),')") &
320 70 : blacs_env%mepos(1), blacs_env%mepos(2)
321 : WRITE (unit=unit_nr, fmt="(' num_pe=(',i8,',',i8,'),')") &
322 70 : blacs_env%num_pe(1), blacs_env%num_pe(2)
323 70 : IF (ASSOCIATED(blacs_env%blacs2mpi)) THEN
324 70 : WRITE (unit=unit_nr, fmt="(' blacs2mpi=')", advance="no")
325 70 : CALL cp_2d_i_write(blacs_env%blacs2mpi, unit_nr=unit_nr)
326 : ELSE
327 0 : WRITE (unit=unit_nr, fmt="(' blacs2mpi=*null*')")
328 : END IF
329 70 : IF (ASSOCIATED(blacs_env%para_env)) THEN
330 : WRITE (unit=unit_nr, fmt="(' para_env=<cp_para_env id=',i6,'>,')") &
331 70 : blacs_env%para_env%get_handle()
332 : ELSE
333 0 : WRITE (unit=unit_nr, fmt="(' para_env=*null*')")
334 : END IF
335 : WRITE (unit=unit_nr, fmt="(' my_pid=',i10,', n_pid=',i10,' }')") &
336 70 : blacs_env%my_pid, blacs_env%n_pid
337 70 : CALL m_flush(unit_nr)
338 70 : END SUBROUTINE cp_blacs_env_write
339 :
340 0 : END MODULE cp_blacs_env
|
