(git:b6ef100)
Loading...
Searching...
No Matches
distribution_2d_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 stores a mapping of 2D info (e.g. matrix) on a
10!> 2D processor distribution (i.e. blacs grid)
11!> where cpus in the same blacs row own the same rows of the 2D info
12!> (and similar for the cols)
13!> \author Joost VandeVondele (2003-08)
14! **************************************************************************************************
15MODULE distribution_2d_types
16
17 USE cp_array_utils, ONLY: cp_1d_i_p_type,&
18 cp_1d_i_write
19 USE cp_blacs_env, ONLY: cp_blacs_env_release,&
20 cp_blacs_env_type
21 USE cp_log_handling, ONLY: cp_get_default_logger,&
22 cp_logger_type
23 USE machine, ONLY: m_flush
24#include "base/base_uses.f90"
25
26 IMPLICIT NONE
27 PRIVATE
28
29 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'distribution_2d_types'
30
31 PUBLIC :: distribution_2d_type
32
33 PUBLIC :: distribution_2d_create, &
34 distribution_2d_release, &
35 distribution_2d_retain, &
36 distribution_2d_write, &
37 distribution_2d_get
38
39! **************************************************************************************************
40!> \brief distributes pairs on a 2d grid of processors
41!> \param row_distribution (i): processor row that owns the row i
42!> \param col_distribution (i): processor col that owns the col i
43!> \param n_row_distribution nuber of global rows
44!> \param n_col_distribution number of global cols
45!> \param n_local_rows (ikind): number of local rows of kind ikind
46!> \param n_local_cols (ikind): number of local cols of kind ikind
47!> \param local_cols (ikind)%array: ordered global indexes of the local cols
48!> of kind ikind (might be oversized)
49!> \param local_rows (ikind)%array: ordered global indexes of the local
50!> rows of kind ikind (might be oversized)
51!> \param flat_local_rows ordered global indexes of the local rows
52!> (allocated on request, might be oversized)
53!> \param flat_local_cols ordered global indexes of the local cols
54!> (allocated on request, might be oversized)
55!> \param blacs_env parallel environment in which the pairs are distributed
56!> \param ref_count reference count (see doc/ReferenceCounting.html)
57!> \par History
58!> 08.2003 created [joost]
59!> 09.2003 kind separation, minor cleanup [fawzi]
60!> \author Joost & Fawzi
61! **************************************************************************************************
62 TYPE distribution_2d_type
63 INTEGER, DIMENSION(:, :), POINTER :: row_distribution => null()
64 INTEGER, DIMENSION(:, :), POINTER :: col_distribution => null()
65 INTEGER :: n_row_distribution = 0
66 INTEGER :: n_col_distribution = 0
67 INTEGER, DIMENSION(:), POINTER :: n_local_rows => null()
68 INTEGER, DIMENSION(:), POINTER :: n_local_cols => null()
69 TYPE(cp_1d_i_p_type), DIMENSION(:), POINTER :: local_rows => null()
70 TYPE(cp_1d_i_p_type), DIMENSION(:), POINTER :: local_cols => null()
71 INTEGER, DIMENSION(:), POINTER :: flat_local_rows => null()
72 INTEGER, DIMENSION(:), POINTER :: flat_local_cols => null()
73 TYPE(cp_blacs_env_type), POINTER :: blacs_env => null()
74 INTEGER :: ref_count = 0
75 END TYPE distribution_2d_type
76
77CONTAINS
78
79! **************************************************************************************************
80!> \brief initializes the distribution_2d
81!> \param distribution_2d ...
82!> \param blacs_env ...
83!> \param local_rows_ptr ...
84!> \param n_local_rows ...
85!> \param local_cols_ptr ...
86!> \param row_distribution_ptr 2D array, first is atom to processor 2nd is
87!> atom to cluster
88!> \param col_distribution_ptr ...
89!> \param n_local_cols ...
90!> \param n_row_distribution ...
91!> \param n_col_distribution ...
92!> \par History
93!> 09.2003 rewamped [fawzi]
94!> \author Joost VandeVondele
95!> \note
96!> the row and col_distribution are not allocated if not given
97! **************************************************************************************************
98 SUBROUTINE distribution_2d_create(distribution_2d, blacs_env, &
99 local_rows_ptr, n_local_rows, &
100 local_cols_ptr, row_distribution_ptr, col_distribution_ptr, &
101 n_local_cols, n_row_distribution, n_col_distribution)
102 TYPE(distribution_2d_type), POINTER :: distribution_2d
103 TYPE(cp_blacs_env_type), POINTER :: blacs_env
104 TYPE(cp_1d_i_p_type), DIMENSION(:), OPTIONAL, &
105 POINTER :: local_rows_ptr
106 INTEGER, DIMENSION(:), INTENT(in), OPTIONAL :: n_local_rows
107 TYPE(cp_1d_i_p_type), DIMENSION(:), OPTIONAL, &
108 POINTER :: local_cols_ptr
109 INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: row_distribution_ptr, &
110 col_distribution_ptr
111 INTEGER, DIMENSION(:), INTENT(in), OPTIONAL :: n_local_cols
112 INTEGER, INTENT(in), OPTIONAL :: n_row_distribution, n_col_distribution
113
114 INTEGER :: i
115
116 cpassert(ASSOCIATED(blacs_env))
117 cpassert(.NOT. ASSOCIATED(distribution_2d))
118
119 ALLOCATE (distribution_2d)
120 distribution_2d%ref_count = 1
121
122 NULLIFY (distribution_2d%col_distribution, distribution_2d%row_distribution, &
123 distribution_2d%local_rows, distribution_2d%local_cols, &
124 distribution_2d%blacs_env, distribution_2d%n_local_cols, &
125 distribution_2d%n_local_rows, distribution_2d%flat_local_rows, &
126 distribution_2d%flat_local_cols)
127
128 distribution_2d%n_col_distribution = -huge(0)
129 IF (PRESENT(col_distribution_ptr)) THEN
130 distribution_2d%col_distribution => col_distribution_ptr
131 distribution_2d%n_col_distribution = SIZE(distribution_2d%col_distribution, 1)
132 END IF
133 IF (PRESENT(n_col_distribution)) THEN
134 IF (ASSOCIATED(distribution_2d%col_distribution)) THEN
135 IF (n_col_distribution > distribution_2d%n_col_distribution) THEN
136 cpabort("n_col_distribution<=distribution_2d%n_col_distribution")
137 END IF
138 ! else alloc col_distribution?
139 END IF
140 distribution_2d%n_col_distribution = n_col_distribution
141 END IF
142 distribution_2d%n_row_distribution = -huge(0)
143 IF (PRESENT(row_distribution_ptr)) THEN
144 distribution_2d%row_distribution => row_distribution_ptr
145 distribution_2d%n_row_distribution = SIZE(distribution_2d%row_distribution, 1)
146 END IF
147 IF (PRESENT(n_row_distribution)) THEN
148 IF (ASSOCIATED(distribution_2d%row_distribution)) THEN
149 IF (n_row_distribution > distribution_2d%n_row_distribution) THEN
150 cpabort("n_row_distribution<=distribution_2d%n_row_distribution")
151 END IF
152 ! else alloc row_distribution?
153 END IF
154 distribution_2d%n_row_distribution = n_row_distribution
155 END IF
156
157 IF (PRESENT(local_rows_ptr)) THEN
158 distribution_2d%local_rows => local_rows_ptr
159 END IF
160 IF (.NOT. ASSOCIATED(distribution_2d%local_rows)) THEN
161 cpassert(PRESENT(n_local_rows))
162 ALLOCATE (distribution_2d%local_rows(SIZE(n_local_rows)))
163 DO i = 1, SIZE(distribution_2d%local_rows)
164 ALLOCATE (distribution_2d%local_rows(i)%array(n_local_rows(i)))
165 distribution_2d%local_rows(i)%array = -huge(0)
166 END DO
167 END IF
168 ALLOCATE (distribution_2d%n_local_rows(SIZE(distribution_2d%local_rows)))
169 IF (PRESENT(n_local_rows)) THEN
170 IF (SIZE(distribution_2d%n_local_rows) /= SIZE(n_local_rows)) THEN
171 cpabort("SIZE(distribution_2d%n_local_rows)==SIZE(n_local_rows)")
172 END IF
173 DO i = 1, SIZE(distribution_2d%n_local_rows)
174 IF (SIZE(distribution_2d%local_rows(i)%array) < n_local_rows(i)) THEN
175 cpabort("SIZE(distribution_2d%local_rows(i)%array)>=n_local_rows(i)")
176 END IF
177 distribution_2d%n_local_rows(i) = n_local_rows(i)
178 END DO
179 ELSE
180 DO i = 1, SIZE(distribution_2d%n_local_rows)
181 distribution_2d%n_local_rows(i) = &
182 SIZE(distribution_2d%local_rows(i)%array)
183 END DO
184 END IF
185
186 IF (PRESENT(local_cols_ptr)) THEN
187 distribution_2d%local_cols => local_cols_ptr
188 END IF
189 IF (.NOT. ASSOCIATED(distribution_2d%local_cols)) THEN
190 cpassert(PRESENT(n_local_cols))
191 ALLOCATE (distribution_2d%local_cols(SIZE(n_local_cols)))
192 DO i = 1, SIZE(distribution_2d%local_cols)
193 ALLOCATE (distribution_2d%local_cols(i)%array(n_local_cols(i)))
194 distribution_2d%local_cols(i)%array = -huge(0)
195 END DO
196 END IF
197 ALLOCATE (distribution_2d%n_local_cols(SIZE(distribution_2d%local_cols)))
198 IF (PRESENT(n_local_cols)) THEN
199 IF (SIZE(distribution_2d%n_local_cols) /= SIZE(n_local_cols)) THEN
200 cpabort("SIZE(distribution_2d%n_local_cols)==SIZE(n_local_cols)")
201 END IF
202 DO i = 1, SIZE(distribution_2d%n_local_cols)
203 IF (SIZE(distribution_2d%local_cols(i)%array) < n_local_cols(i)) THEN
204 cpabort("SIZE(distribution_2d%local_cols(i)%array)>=n_local_cols(i)")
205 END IF
206 distribution_2d%n_local_cols(i) = n_local_cols(i)
207 END DO
208 ELSE
209 DO i = 1, SIZE(distribution_2d%n_local_cols)
210 distribution_2d%n_local_cols(i) = &
211 SIZE(distribution_2d%local_cols(i)%array)
212 END DO
213 END IF
214
215 distribution_2d%blacs_env => blacs_env
216 CALL distribution_2d%blacs_env%retain()
217
218 END SUBROUTINE distribution_2d_create
219
220! **************************************************************************************************
221!> \brief ...
222!> \param distribution_2d ...
223!> \author Joost VandeVondele
224! **************************************************************************************************
225 SUBROUTINE distribution_2d_retain(distribution_2d)
226 TYPE(distribution_2d_type), POINTER :: distribution_2d
227
228 cpassert(ASSOCIATED(distribution_2d))
229 cpassert(distribution_2d%ref_count > 0)
230 distribution_2d%ref_count = distribution_2d%ref_count + 1
231 END SUBROUTINE distribution_2d_retain
232
233! **************************************************************************************************
234!> \brief ...
235!> \param distribution_2d ...
236! **************************************************************************************************
237 SUBROUTINE distribution_2d_release(distribution_2d)
238 TYPE(distribution_2d_type), POINTER :: distribution_2d
239
240 INTEGER :: i
241
242 IF (ASSOCIATED(distribution_2d)) THEN
243 cpassert(distribution_2d%ref_count > 0)
244 distribution_2d%ref_count = distribution_2d%ref_count - 1
245 IF (distribution_2d%ref_count == 0) THEN
246 CALL cp_blacs_env_release(distribution_2d%blacs_env)
247 IF (ASSOCIATED(distribution_2d%col_distribution)) THEN
248 DEALLOCATE (distribution_2d%col_distribution)
249 END IF
250 IF (ASSOCIATED(distribution_2d%row_distribution)) THEN
251 DEALLOCATE (distribution_2d%row_distribution)
252 END IF
253 DO i = 1, SIZE(distribution_2d%local_rows)
254 DEALLOCATE (distribution_2d%local_rows(i)%array)
255 END DO
256 DEALLOCATE (distribution_2d%local_rows)
257 DO i = 1, SIZE(distribution_2d%local_cols)
258 DEALLOCATE (distribution_2d%local_cols(i)%array)
259 END DO
260 DEALLOCATE (distribution_2d%local_cols)
261 IF (ASSOCIATED(distribution_2d%flat_local_rows)) THEN
262 DEALLOCATE (distribution_2d%flat_local_rows)
263 END IF
264 IF (ASSOCIATED(distribution_2d%flat_local_cols)) THEN
265 DEALLOCATE (distribution_2d%flat_local_cols)
266 END IF
267 IF (ASSOCIATED(distribution_2d%n_local_rows)) THEN
268 DEALLOCATE (distribution_2d%n_local_rows)
269 END IF
270 IF (ASSOCIATED(distribution_2d%n_local_cols)) THEN
271 DEALLOCATE (distribution_2d%n_local_cols)
272 END IF
273 DEALLOCATE (distribution_2d)
274 END IF
275 END IF
276 NULLIFY (distribution_2d)
277 END SUBROUTINE distribution_2d_release
278
279! **************************************************************************************************
280!> \brief writes out the given distribution
281!> \param distribution_2d the distribution to write out
282!> \param unit_nr the unit to write to
283!> \param local if the unit is local to to each processor (otherwise
284!> only the processor with logger%para_env%source==
285!> logger%para_env%mepos writes), defaults to false.
286!> \param long_description if a long description should be given,
287!> defaults to false
288!> \par History
289!> 08.2003 adapted qs_distribution_2d_create write done by Matthias[fawzi]
290!> \author Fawzi Mohamed
291!> \note
292!> to clean up, make safer wrt. grabage in distribution_2d%n_*
293! **************************************************************************************************
294 SUBROUTINE distribution_2d_write(distribution_2d, unit_nr, local, &
295 long_description)
296 TYPE(distribution_2d_type), POINTER :: distribution_2d
297 INTEGER, INTENT(in) :: unit_nr
298 LOGICAL, INTENT(in), OPTIONAL :: local, long_description
299
300 INTEGER :: i
301 LOGICAL :: my_local, my_long_description
302 TYPE(cp_logger_type), POINTER :: logger
303
304 logger => cp_get_default_logger()
305
306 my_long_description = .false.
307 IF (PRESENT(long_description)) my_long_description = long_description
308 my_local = .false.
309 IF (PRESENT(local)) my_local = local
310 IF (.NOT. my_local) my_local = logger%para_env%is_source()
311
312 IF (ASSOCIATED(distribution_2d)) THEN
313 IF (my_local) THEN
314 WRITE (unit=unit_nr, &
315 fmt="(/,' <distribution_2d> { ref_count=',i10,',')") &
316 distribution_2d%ref_count
317
318 WRITE (unit=unit_nr, fmt="(' n_row_distribution=',i15,',')") &
319 distribution_2d%n_row_distribution
320 IF (ASSOCIATED(distribution_2d%row_distribution)) THEN
321 IF (my_long_description) THEN
322 WRITE (unit=unit_nr, fmt="(' row_distribution= (')", advance="no")
323 DO i = 1, SIZE(distribution_2d%row_distribution, 1)
324 WRITE (unit=unit_nr, fmt="(i6,',')", advance="no") distribution_2d%row_distribution(i, 1)
325 ! keep lines finite, so that we can open outputs in vi
326 IF (modulo(i, 8) == 0 .AND. i /= SIZE(distribution_2d%row_distribution, 1)) THEN
327 WRITE (unit=unit_nr, fmt='()')
328 END IF
329 END DO
330 WRITE (unit=unit_nr, fmt="('),')")
331 ELSE
332 WRITE (unit=unit_nr, fmt="(' row_distribution= array(',i6,':',i6,'),')") &
333 lbound(distribution_2d%row_distribution(:, 1)), &
334 ubound(distribution_2d%row_distribution(:, 1))
335 END IF
336 ELSE
337 WRITE (unit=unit_nr, fmt="(' row_distribution=*null*,')")
338 END IF
339
340 WRITE (unit=unit_nr, fmt="(' n_col_distribution=',i15,',')") &
341 distribution_2d%n_col_distribution
342 IF (ASSOCIATED(distribution_2d%col_distribution)) THEN
343 IF (my_long_description) THEN
344 WRITE (unit=unit_nr, fmt="(' col_distribution= (')", advance="no")
345 DO i = 1, SIZE(distribution_2d%col_distribution, 1)
346 WRITE (unit=unit_nr, fmt="(i6,',')", advance="no") distribution_2d%col_distribution(i, 1)
347 ! keep lines finite, so that we can open outputs in vi
348 IF (modulo(i, 8) == 0 .AND. i /= SIZE(distribution_2d%col_distribution, 1)) THEN
349 WRITE (unit=unit_nr, fmt='()')
350 END IF
351 END DO
352 WRITE (unit=unit_nr, fmt="('),')")
353 ELSE
354 WRITE (unit=unit_nr, fmt="(' col_distribution= array(',i6,':',i6,'),')") &
355 lbound(distribution_2d%col_distribution(:, 1)), &
356 ubound(distribution_2d%col_distribution(:, 1))
357 END IF
358 ELSE
359 WRITE (unit=unit_nr, fmt="(' col_distribution=*null*,')")
360 END IF
361
362 IF (ASSOCIATED(distribution_2d%n_local_rows)) THEN
363 IF (my_long_description) THEN
364 WRITE (unit=unit_nr, fmt="(' n_local_rows= (')", advance="no")
365 DO i = 1, SIZE(distribution_2d%n_local_rows)
366 WRITE (unit=unit_nr, fmt="(i6,',')", advance="no") distribution_2d%n_local_rows(i)
367 ! keep lines finite, so that we can open outputs in vi
368 IF (modulo(i, 10) == 0 .AND. i /= SIZE(distribution_2d%n_local_rows)) THEN
369 WRITE (unit=unit_nr, fmt='()')
370 END IF
371 END DO
372 WRITE (unit=unit_nr, fmt="('),')")
373 ELSE
374 WRITE (unit=unit_nr, fmt="(' n_local_rows= array(',i6,':',i6,'),')") &
375 lbound(distribution_2d%n_local_rows), &
376 ubound(distribution_2d%n_local_rows)
377 END IF
378 ELSE
379 WRITE (unit=unit_nr, fmt="(' n_local_rows=*null*,')")
380 END IF
381
382 IF (ASSOCIATED(distribution_2d%local_rows)) THEN
383 WRITE (unit=unit_nr, fmt="(' local_rows=(')")
384 DO i = 1, SIZE(distribution_2d%local_rows)
385 IF (ASSOCIATED(distribution_2d%local_rows(i)%array)) THEN
386 IF (my_long_description) THEN
387 CALL cp_1d_i_write(array=distribution_2d%local_rows(i)%array, &
388 unit_nr=unit_nr)
389 ELSE
390 WRITE (unit=unit_nr, fmt="(' array(',i6,':',i6,'),')") &
391 lbound(distribution_2d%local_rows(i)%array), &
392 ubound(distribution_2d%local_rows(i)%array)
393 END IF
394 ELSE
395 WRITE (unit=unit_nr, fmt="('*null*')")
396 END IF
397 END DO
398 WRITE (unit=unit_nr, fmt="(' ),')")
399 ELSE
400 WRITE (unit=unit_nr, fmt="(' local_rows=*null*,')")
401 END IF
402
403 IF (ASSOCIATED(distribution_2d%n_local_cols)) THEN
404 IF (my_long_description) THEN
405 WRITE (unit=unit_nr, fmt="(' n_local_cols= (')", advance="no")
406 DO i = 1, SIZE(distribution_2d%n_local_cols)
407 WRITE (unit=unit_nr, fmt="(i6,',')", advance="no") distribution_2d%n_local_cols(i)
408 ! keep lines finite, so that we can open outputs in vi
409 IF (modulo(i, 10) == 0 .AND. i /= SIZE(distribution_2d%n_local_cols)) THEN
410 WRITE (unit=unit_nr, fmt='()')
411 END IF
412 END DO
413 WRITE (unit=unit_nr, fmt="('),')")
414 ELSE
415 WRITE (unit=unit_nr, fmt="(' n_local_cols= array(',i6,':',i6,'),')") &
416 lbound(distribution_2d%n_local_cols), &
417 ubound(distribution_2d%n_local_cols)
418 END IF
419 ELSE
420 WRITE (unit=unit_nr, fmt="(' n_local_cols=*null*,')")
421 END IF
422
423 IF (ASSOCIATED(distribution_2d%local_cols)) THEN
424 WRITE (unit=unit_nr, fmt="(' local_cols=(')")
425 DO i = 1, SIZE(distribution_2d%local_cols)
426 IF (ASSOCIATED(distribution_2d%local_cols(i)%array)) THEN
427 IF (my_long_description) THEN
428 CALL cp_1d_i_write(array=distribution_2d%local_cols(i)%array, &
429 unit_nr=unit_nr)
430 ELSE
431 WRITE (unit=unit_nr, fmt="(' array(',i6,':',i6,'),')") &
432 lbound(distribution_2d%local_cols(i)%array), &
433 ubound(distribution_2d%local_cols(i)%array)
434 END IF
435 ELSE
436 WRITE (unit=unit_nr, fmt="('*null*')")
437 END IF
438 END DO
439 WRITE (unit=unit_nr, fmt="(' ),')")
440 ELSE
441 WRITE (unit=unit_nr, fmt="(' local_cols=*null*,')")
442 END IF
443
444 IF (ASSOCIATED(distribution_2d%blacs_env)) THEN
445 IF (my_long_description) THEN
446 WRITE (unit=unit_nr, fmt="(' blacs_env=')", advance="no")
447 CALL distribution_2d%blacs_env%write(unit_nr)
448 ELSE
449 WRITE (unit=unit_nr, fmt="(' blacs_env=<blacs_env id=',i6,'>')") &
450 distribution_2d%blacs_env%get_handle()
451 END IF
452 ELSE
453 WRITE (unit=unit_nr, fmt="(' blacs_env=*null*')")
454 END IF
455
456 WRITE (unit=unit_nr, fmt="(' }')")
457 END IF
458
459 ELSE IF (my_local) THEN
460 WRITE (unit=unit_nr, &
461 fmt="(' <distribution_2d *null*>')")
462 END IF
463
464 CALL m_flush(unit_nr)
465
466 END SUBROUTINE distribution_2d_write
467
468! **************************************************************************************************
469!> \brief returns various attributes about the distribution_2d
470!> \param distribution_2d the object you want info about
471!> \param row_distribution ...
472!> \param col_distribution ...
473!> \param n_row_distribution ...
474!> \param n_col_distribution ...
475!> \param n_local_rows ...
476!> \param n_local_cols ...
477!> \param local_rows ...
478!> \param local_cols ...
479!> \param flat_local_rows ...
480!> \param flat_local_cols ...
481!> \param n_flat_local_rows ...
482!> \param n_flat_local_cols ...
483!> \param blacs_env ...
484!> \par History
485!> 09.2003 created [fawzi]
486!> \author Fawzi Mohamed
487! **************************************************************************************************
488 SUBROUTINE distribution_2d_get(distribution_2d, row_distribution, &
489 col_distribution, n_row_distribution, n_col_distribution, &
490 n_local_rows, n_local_cols, local_rows, local_cols, &
491 flat_local_rows, flat_local_cols, n_flat_local_rows, n_flat_local_cols, &
492 blacs_env)
493 TYPE(distribution_2d_type), POINTER :: distribution_2d
494 INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: row_distribution, col_distribution
495 INTEGER, INTENT(out), OPTIONAL :: n_row_distribution, n_col_distribution
496 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: n_local_rows, n_local_cols
497 TYPE(cp_1d_i_p_type), DIMENSION(:), OPTIONAL, &
498 POINTER :: local_rows, local_cols
499 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: flat_local_rows, flat_local_cols
500 INTEGER, INTENT(out), OPTIONAL :: n_flat_local_rows, n_flat_local_cols
501 TYPE(cp_blacs_env_type), OPTIONAL, POINTER :: blacs_env
502
503 INTEGER :: iblock_atomic, iblock_min, ikind, &
504 ikind_min
505 INTEGER, ALLOCATABLE, DIMENSION(:) :: multiindex
506
507 cpassert(ASSOCIATED(distribution_2d))
508 cpassert(distribution_2d%ref_count > 0)
509 IF (PRESENT(row_distribution)) row_distribution => distribution_2d%row_distribution
510 IF (PRESENT(col_distribution)) col_distribution => distribution_2d%col_distribution
511 IF (PRESENT(n_row_distribution)) n_row_distribution = distribution_2d%n_row_distribution
512 IF (PRESENT(n_col_distribution)) n_col_distribution = distribution_2d%n_col_distribution
513 IF (PRESENT(n_local_rows)) n_local_rows => distribution_2d%n_local_rows
514 IF (PRESENT(n_local_cols)) n_local_cols => distribution_2d%n_local_cols
515 IF (PRESENT(local_rows)) local_rows => distribution_2d%local_rows
516 IF (PRESENT(local_cols)) local_cols => distribution_2d%local_cols
517 IF (PRESENT(flat_local_rows)) THEN
518 IF (.NOT. ASSOCIATED(distribution_2d%flat_local_rows)) THEN
519 ALLOCATE (multiindex(SIZE(distribution_2d%local_rows)), &
520 distribution_2d%flat_local_rows(sum(distribution_2d%n_local_rows)))
521 multiindex = 1
522 DO iblock_atomic = 1, SIZE(distribution_2d%flat_local_rows)
523 iblock_min = huge(0)
524 ikind_min = -huge(0)
525 DO ikind = 1, SIZE(distribution_2d%local_rows)
526 IF (multiindex(ikind) <= distribution_2d%n_local_rows(ikind)) THEN
527 IF (distribution_2d%local_rows(ikind)%array(multiindex(ikind)) < &
528 iblock_min) THEN
529 iblock_min = distribution_2d%local_rows(ikind)%array(multiindex(ikind))
530 ikind_min = ikind
531 END IF
532 END IF
533 END DO
534 cpassert(ikind_min > 0)
535 distribution_2d%flat_local_rows(iblock_atomic) = &
536 distribution_2d%local_rows(ikind_min)%array(multiindex(ikind_min))
537 multiindex(ikind_min) = multiindex(ikind_min) + 1
538 END DO
539 DEALLOCATE (multiindex)
540 END IF
541 flat_local_rows => distribution_2d%flat_local_rows
542 END IF
543 IF (PRESENT(flat_local_cols)) THEN
544 IF (.NOT. ASSOCIATED(distribution_2d%flat_local_cols)) THEN
545 ALLOCATE (multiindex(SIZE(distribution_2d%local_cols)), &
546 distribution_2d%flat_local_cols(sum(distribution_2d%n_local_cols)))
547 multiindex = 1
548 DO iblock_atomic = 1, SIZE(distribution_2d%flat_local_cols)
549 iblock_min = huge(0)
550 ikind_min = -huge(0)
551 DO ikind = 1, SIZE(distribution_2d%local_cols)
552 IF (multiindex(ikind) <= distribution_2d%n_local_cols(ikind)) THEN
553 IF (distribution_2d%local_cols(ikind)%array(multiindex(ikind)) < &
554 iblock_min) THEN
555 iblock_min = distribution_2d%local_cols(ikind)%array(multiindex(ikind))
556 ikind_min = ikind
557 END IF
558 END IF
559 END DO
560 cpassert(ikind_min > 0)
561 distribution_2d%flat_local_cols(iblock_atomic) = &
562 distribution_2d%local_cols(ikind_min)%array(multiindex(ikind_min))
563 multiindex(ikind_min) = multiindex(ikind_min) + 1
564 END DO
565 DEALLOCATE (multiindex)
566 END IF
567 flat_local_cols => distribution_2d%flat_local_cols
568 END IF
569 IF (PRESENT(n_flat_local_rows)) n_flat_local_rows = sum(distribution_2d%n_local_rows)
570 IF (PRESENT(n_flat_local_cols)) n_flat_local_cols = sum(distribution_2d%n_local_cols)
571 IF (PRESENT(blacs_env)) blacs_env => distribution_2d%blacs_env
572 END SUBROUTINE distribution_2d_get
573
574END MODULE distribution_2d_types
modulo
static GRID_HOST_DEVICE int modulo(int a, int m)
Equivalent of Fortran's MODULO, which always return a positive number. https://gcc....
Definition grid_common.h:125
cp_array_utils
various utilities that regard array of different kinds: output, allocation,... maybe it is not a good...
Definition cp_array_utils.F:18
cp_array_utils::cp_1d_i_write
subroutine, public cp_1d_i_write(array, unit_nr, el_format)
writes an array to the given unit
Definition cp_array_utils.F:734
cp_blacs_env
methods related to the blacs parallel environment
Definition cp_blacs_env.F:15
cp_blacs_env::cp_blacs_env_release
subroutine, public cp_blacs_env_release(blacs_env)
releases the given blacs_env
Definition cp_blacs_env.F:274
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition cp_log_handling.F:41
cp_log_handling::cp_get_default_logger
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Definition cp_log_handling.F:234
distribution_2d_types
stores a mapping of 2D info (e.g. matrix) on a 2D processor distribution (i.e. blacs grid) where cpus...
Definition distribution_2d_types.F:15
distribution_2d_types::distribution_2d_create
subroutine, public distribution_2d_create(distribution_2d, blacs_env, local_rows_ptr, n_local_rows, local_cols_ptr, row_distribution_ptr, col_distribution_ptr, n_local_cols, n_row_distribution, n_col_distribution)
initializes the distribution_2d
Definition distribution_2d_types.F:102
distribution_2d_types::distribution_2d_release
subroutine, public distribution_2d_release(distribution_2d)
...
Definition distribution_2d_types.F:238
distribution_2d_types::distribution_2d_get
subroutine, public distribution_2d_get(distribution_2d, row_distribution, col_distribution, n_row_distribution, n_col_distribution, n_local_rows, n_local_cols, local_rows, local_cols, flat_local_rows, flat_local_cols, n_flat_local_rows, n_flat_local_cols, blacs_env)
returns various attributes about the distribution_2d
Definition distribution_2d_types.F:493
distribution_2d_types::distribution_2d_write
subroutine, public distribution_2d_write(distribution_2d, unit_nr, local, long_description)
writes out the given distribution
Definition distribution_2d_types.F:296
distribution_2d_types::distribution_2d_retain
subroutine, public distribution_2d_retain(distribution_2d)
...
Definition distribution_2d_types.F:226
machine
Machine interface based on Fortran 2003 and POSIX.
Definition machine.F:17
machine::m_flush
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
Definition machine.F:124
cp_array_utils::cp_1d_i_p_type
represent a pointer to a 1d array
Definition cp_array_utils.F:221
cp_blacs_env::cp_blacs_env_type
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
Definition cp_blacs_env.F:53
cp_log_handling::cp_logger_type
type of a logger, at the moment it contains just a print level starting at which level it should be l...
Definition cp_log_handling.F:140
distribution_2d_types::distribution_2d_type
distributes pairs on a 2d grid of processors
Definition distribution_2d_types.F:62