(git:374b731)
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-2024 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) &
136 cpabort("n_col_distribution<=distribution_2d%n_col_distribution")
137 ! else alloc col_distribution?
138 END IF
139 distribution_2d%n_col_distribution = n_col_distribution
140 END IF
141 distribution_2d%n_row_distribution = -huge(0)
142 IF (PRESENT(row_distribution_ptr)) THEN
143 distribution_2d%row_distribution => row_distribution_ptr
144 distribution_2d%n_row_distribution = SIZE(distribution_2d%row_distribution, 1)
145 END IF
146 IF (PRESENT(n_row_distribution)) THEN
147 IF (ASSOCIATED(distribution_2d%row_distribution)) THEN
148 IF (n_row_distribution > distribution_2d%n_row_distribution) &
149 cpabort("n_row_distribution<=distribution_2d%n_row_distribution")
150 ! else alloc row_distribution?
151 END IF
152 distribution_2d%n_row_distribution = n_row_distribution
153 END IF
154
155 IF (PRESENT(local_rows_ptr)) &
156 distribution_2d%local_rows => local_rows_ptr
157 IF (.NOT. ASSOCIATED(distribution_2d%local_rows)) THEN
158 cpassert(PRESENT(n_local_rows))
159 ALLOCATE (distribution_2d%local_rows(SIZE(n_local_rows)))
160 DO i = 1, SIZE(distribution_2d%local_rows)
161 ALLOCATE (distribution_2d%local_rows(i)%array(n_local_rows(i)))
162 distribution_2d%local_rows(i)%array = -huge(0)
163 END DO
164 END IF
165 ALLOCATE (distribution_2d%n_local_rows(SIZE(distribution_2d%local_rows)))
166 IF (PRESENT(n_local_rows)) THEN
167 IF (SIZE(distribution_2d%n_local_rows) /= SIZE(n_local_rows)) &
168 cpabort("SIZE(distribution_2d%n_local_rows)==SIZE(n_local_rows)")
169 DO i = 1, SIZE(distribution_2d%n_local_rows)
170 IF (SIZE(distribution_2d%local_rows(i)%array) < n_local_rows(i)) &
171 cpabort("SIZE(distribution_2d%local_rows(i)%array)>=n_local_rows(i)")
172 distribution_2d%n_local_rows(i) = n_local_rows(i)
173 END DO
174 ELSE
175 DO i = 1, SIZE(distribution_2d%n_local_rows)
176 distribution_2d%n_local_rows(i) = &
177 SIZE(distribution_2d%local_rows(i)%array)
178 END DO
179 END IF
180
181 IF (PRESENT(local_cols_ptr)) &
182 distribution_2d%local_cols => local_cols_ptr
183 IF (.NOT. ASSOCIATED(distribution_2d%local_cols)) THEN
184 cpassert(PRESENT(n_local_cols))
185 ALLOCATE (distribution_2d%local_cols(SIZE(n_local_cols)))
186 DO i = 1, SIZE(distribution_2d%local_cols)
187 ALLOCATE (distribution_2d%local_cols(i)%array(n_local_cols(i)))
188 distribution_2d%local_cols(i)%array = -huge(0)
189 END DO
190 END IF
191 ALLOCATE (distribution_2d%n_local_cols(SIZE(distribution_2d%local_cols)))
192 IF (PRESENT(n_local_cols)) THEN
193 IF (SIZE(distribution_2d%n_local_cols) /= SIZE(n_local_cols)) &
194 cpabort("SIZE(distribution_2d%n_local_cols)==SIZE(n_local_cols)")
195 DO i = 1, SIZE(distribution_2d%n_local_cols)
196 IF (SIZE(distribution_2d%local_cols(i)%array) < n_local_cols(i)) &
197 cpabort("SIZE(distribution_2d%local_cols(i)%array)>=n_local_cols(i)")
198 distribution_2d%n_local_cols(i) = n_local_cols(i)
199 END DO
200 ELSE
201 DO i = 1, SIZE(distribution_2d%n_local_cols)
202 distribution_2d%n_local_cols(i) = &
203 SIZE(distribution_2d%local_cols(i)%array)
204 END DO
205 END IF
206
207 distribution_2d%blacs_env => blacs_env
208 CALL distribution_2d%blacs_env%retain()
209
210 END SUBROUTINE distribution_2d_create
211
212! **************************************************************************************************
213!> \brief ...
214!> \param distribution_2d ...
215!> \author Joost VandeVondele
216! **************************************************************************************************
217 SUBROUTINE distribution_2d_retain(distribution_2d)
218 TYPE(distribution_2d_type), POINTER :: distribution_2d
219
220 cpassert(ASSOCIATED(distribution_2d))
221 cpassert(distribution_2d%ref_count > 0)
222 distribution_2d%ref_count = distribution_2d%ref_count + 1
223 END SUBROUTINE distribution_2d_retain
224
225! **************************************************************************************************
226!> \brief ...
227!> \param distribution_2d ...
228! **************************************************************************************************
229 SUBROUTINE distribution_2d_release(distribution_2d)
230 TYPE(distribution_2d_type), POINTER :: distribution_2d
231
232 INTEGER :: i
233
234 IF (ASSOCIATED(distribution_2d)) THEN
235 cpassert(distribution_2d%ref_count > 0)
236 distribution_2d%ref_count = distribution_2d%ref_count - 1
237 IF (distribution_2d%ref_count == 0) THEN
238 CALL cp_blacs_env_release(distribution_2d%blacs_env)
239 IF (ASSOCIATED(distribution_2d%col_distribution)) THEN
240 DEALLOCATE (distribution_2d%col_distribution)
241 END IF
242 IF (ASSOCIATED(distribution_2d%row_distribution)) THEN
243 DEALLOCATE (distribution_2d%row_distribution)
244 END IF
245 DO i = 1, SIZE(distribution_2d%local_rows)
246 DEALLOCATE (distribution_2d%local_rows(i)%array)
247 END DO
248 DEALLOCATE (distribution_2d%local_rows)
249 DO i = 1, SIZE(distribution_2d%local_cols)
250 DEALLOCATE (distribution_2d%local_cols(i)%array)
251 END DO
252 DEALLOCATE (distribution_2d%local_cols)
253 IF (ASSOCIATED(distribution_2d%flat_local_rows)) THEN
254 DEALLOCATE (distribution_2d%flat_local_rows)
255 END IF
256 IF (ASSOCIATED(distribution_2d%flat_local_cols)) THEN
257 DEALLOCATE (distribution_2d%flat_local_cols)
258 END IF
259 IF (ASSOCIATED(distribution_2d%n_local_rows)) THEN
260 DEALLOCATE (distribution_2d%n_local_rows)
261 END IF
262 IF (ASSOCIATED(distribution_2d%n_local_cols)) THEN
263 DEALLOCATE (distribution_2d%n_local_cols)
264 END IF
265 DEALLOCATE (distribution_2d)
266 END IF
267 END IF
268 NULLIFY (distribution_2d)
269 END SUBROUTINE distribution_2d_release
270
271! **************************************************************************************************
272!> \brief writes out the given distribution
273!> \param distribution_2d the distribution to write out
274!> \param unit_nr the unit to write to
275!> \param local if the unit is local to to each processor (otherwise
276!> only the processor with logger%para_env%source==
277!> logger%para_env%mepos writes), defaults to false.
278!> \param long_description if a long description should be given,
279!> defaults to false
280!> \par History
281!> 08.2003 adapted qs_distribution_2d_create write done by Matthias[fawzi]
282!> \author Fawzi Mohamed
283!> \note
284!> to clean up, make safer wrt. grabage in distribution_2d%n_*
285! **************************************************************************************************
286 SUBROUTINE distribution_2d_write(distribution_2d, unit_nr, local, &
287 long_description)
288 TYPE(distribution_2d_type), POINTER :: distribution_2d
289 INTEGER, INTENT(in) :: unit_nr
290 LOGICAL, INTENT(in), OPTIONAL :: local, long_description
291
292 INTEGER :: i
293 LOGICAL :: my_local, my_long_description
294 TYPE(cp_logger_type), POINTER :: logger
295
296 logger => cp_get_default_logger()
297
298 my_long_description = .false.
299 IF (PRESENT(long_description)) my_long_description = long_description
300 my_local = .false.
301 IF (PRESENT(local)) my_local = local
302 IF (.NOT. my_local) my_local = logger%para_env%is_source()
303
304 IF (ASSOCIATED(distribution_2d)) THEN
305 IF (my_local) THEN
306 WRITE (unit=unit_nr, &
307 fmt="(/,' <distribution_2d> { ref_count=',i10,',')") &
308 distribution_2d%ref_count
309
310 WRITE (unit=unit_nr, fmt="(' n_row_distribution=',i15,',')") &
311 distribution_2d%n_row_distribution
312 IF (ASSOCIATED(distribution_2d%row_distribution)) THEN
313 IF (my_long_description) THEN
314 WRITE (unit=unit_nr, fmt="(' row_distribution= (')", advance="no")
315 DO i = 1, SIZE(distribution_2d%row_distribution, 1)
316 WRITE (unit=unit_nr, fmt="(i6,',')", advance="no") distribution_2d%row_distribution(i, 1)
317 ! keep lines finite, so that we can open outputs in vi
318 IF (modulo(i, 8) == 0 .AND. i .NE. SIZE(distribution_2d%row_distribution, 1)) &
319 WRITE (unit=unit_nr, fmt='()')
320 END DO
321 WRITE (unit=unit_nr, fmt="('),')")
322 ELSE
323 WRITE (unit=unit_nr, fmt="(' row_distribution= array(',i6,':',i6,'),')") &
324 lbound(distribution_2d%row_distribution(:, 1)), &
325 ubound(distribution_2d%row_distribution(:, 1))
326 END IF
327 ELSE
328 WRITE (unit=unit_nr, fmt="(' row_distribution=*null*,')")
329 END IF
330
331 WRITE (unit=unit_nr, fmt="(' n_col_distribution=',i15,',')") &
332 distribution_2d%n_col_distribution
333 IF (ASSOCIATED(distribution_2d%col_distribution)) THEN
334 IF (my_long_description) THEN
335 WRITE (unit=unit_nr, fmt="(' col_distribution= (')", advance="no")
336 DO i = 1, SIZE(distribution_2d%col_distribution, 1)
337 WRITE (unit=unit_nr, fmt="(i6,',')", advance="no") distribution_2d%col_distribution(i, 1)
338 ! keep lines finite, so that we can open outputs in vi
339 IF (modulo(i, 8) == 0 .AND. i .NE. SIZE(distribution_2d%col_distribution, 1)) &
340 WRITE (unit=unit_nr, fmt='()')
341 END DO
342 WRITE (unit=unit_nr, fmt="('),')")
343 ELSE
344 WRITE (unit=unit_nr, fmt="(' col_distribution= array(',i6,':',i6,'),')") &
345 lbound(distribution_2d%col_distribution(:, 1)), &
346 ubound(distribution_2d%col_distribution(:, 1))
347 END IF
348 ELSE
349 WRITE (unit=unit_nr, fmt="(' col_distribution=*null*,')")
350 END IF
351
352 IF (ASSOCIATED(distribution_2d%n_local_rows)) THEN
353 IF (my_long_description) THEN
354 WRITE (unit=unit_nr, fmt="(' n_local_rows= (')", advance="no")
355 DO i = 1, SIZE(distribution_2d%n_local_rows)
356 WRITE (unit=unit_nr, fmt="(i6,',')", advance="no") distribution_2d%n_local_rows(i)
357 ! keep lines finite, so that we can open outputs in vi
358 IF (modulo(i, 10) == 0 .AND. i .NE. SIZE(distribution_2d%n_local_rows)) &
359 WRITE (unit=unit_nr, fmt='()')
360 END DO
361 WRITE (unit=unit_nr, fmt="('),')")
362 ELSE
363 WRITE (unit=unit_nr, fmt="(' n_local_rows= array(',i6,':',i6,'),')") &
364 lbound(distribution_2d%n_local_rows), &
365 ubound(distribution_2d%n_local_rows)
366 END IF
367 ELSE
368 WRITE (unit=unit_nr, fmt="(' n_local_rows=*null*,')")
369 END IF
370
371 IF (ASSOCIATED(distribution_2d%local_rows)) THEN
372 WRITE (unit=unit_nr, fmt="(' local_rows=(')")
373 DO i = 1, SIZE(distribution_2d%local_rows)
374 IF (ASSOCIATED(distribution_2d%local_rows(i)%array)) THEN
375 IF (my_long_description) THEN
376 CALL cp_1d_i_write(array=distribution_2d%local_rows(i)%array, &
377 unit_nr=unit_nr)
378 ELSE
379 WRITE (unit=unit_nr, fmt="(' array(',i6,':',i6,'),')") &
380 lbound(distribution_2d%local_rows(i)%array), &
381 ubound(distribution_2d%local_rows(i)%array)
382 END IF
383 ELSE
384 WRITE (unit=unit_nr, fmt="('*null*')")
385 END IF
386 END DO
387 WRITE (unit=unit_nr, fmt="(' ),')")
388 ELSE
389 WRITE (unit=unit_nr, fmt="(' local_rows=*null*,')")
390 END IF
391
392 IF (ASSOCIATED(distribution_2d%n_local_cols)) THEN
393 IF (my_long_description) THEN
394 WRITE (unit=unit_nr, fmt="(' n_local_cols= (')", advance="no")
395 DO i = 1, SIZE(distribution_2d%n_local_cols)
396 WRITE (unit=unit_nr, fmt="(i6,',')", advance="no") distribution_2d%n_local_cols(i)
397 ! keep lines finite, so that we can open outputs in vi
398 IF (modulo(i, 10) == 0 .AND. i .NE. SIZE(distribution_2d%n_local_cols)) &
399 WRITE (unit=unit_nr, fmt='()')
400 END DO
401 WRITE (unit=unit_nr, fmt="('),')")
402 ELSE
403 WRITE (unit=unit_nr, fmt="(' n_local_cols= array(',i6,':',i6,'),')") &
404 lbound(distribution_2d%n_local_cols), &
405 ubound(distribution_2d%n_local_cols)
406 END IF
407 ELSE
408 WRITE (unit=unit_nr, fmt="(' n_local_cols=*null*,')")
409 END IF
410
411 IF (ASSOCIATED(distribution_2d%local_cols)) THEN
412 WRITE (unit=unit_nr, fmt="(' local_cols=(')")
413 DO i = 1, SIZE(distribution_2d%local_cols)
414 IF (ASSOCIATED(distribution_2d%local_cols(i)%array)) THEN
415 IF (my_long_description) THEN
416 CALL cp_1d_i_write(array=distribution_2d%local_cols(i)%array, &
417 unit_nr=unit_nr)
418 ELSE
419 WRITE (unit=unit_nr, fmt="(' array(',i6,':',i6,'),')") &
420 lbound(distribution_2d%local_cols(i)%array), &
421 ubound(distribution_2d%local_cols(i)%array)
422 END IF
423 ELSE
424 WRITE (unit=unit_nr, fmt="('*null*')")
425 END IF
426 END DO
427 WRITE (unit=unit_nr, fmt="(' ),')")
428 ELSE
429 WRITE (unit=unit_nr, fmt="(' local_cols=*null*,')")
430 END IF
431
432 IF (ASSOCIATED(distribution_2d%blacs_env)) THEN
433 IF (my_long_description) THEN
434 WRITE (unit=unit_nr, fmt="(' blacs_env=')", advance="no")
435 CALL distribution_2d%blacs_env%write(unit_nr)
436 ELSE
437 WRITE (unit=unit_nr, fmt="(' blacs_env=<blacs_env id=',i6,'>')") &
438 distribution_2d%blacs_env%get_handle()
439 END IF
440 ELSE
441 WRITE (unit=unit_nr, fmt="(' blacs_env=*null*')")
442 END IF
443
444 WRITE (unit=unit_nr, fmt="(' }')")
445 END IF
446
447 ELSE IF (my_local) THEN
448 WRITE (unit=unit_nr, &
449 fmt="(' <distribution_2d *null*>')")
450 END IF
451
452 CALL m_flush(unit_nr)
453
454 END SUBROUTINE distribution_2d_write
455
456! **************************************************************************************************
457!> \brief returns various attributes about the distribution_2d
458!> \param distribution_2d the object you want info about
459!> \param row_distribution ...
460!> \param col_distribution ...
461!> \param n_row_distribution ...
462!> \param n_col_distribution ...
463!> \param n_local_rows ...
464!> \param n_local_cols ...
465!> \param local_rows ...
466!> \param local_cols ...
467!> \param flat_local_rows ...
468!> \param flat_local_cols ...
469!> \param n_flat_local_rows ...
470!> \param n_flat_local_cols ...
471!> \param blacs_env ...
472!> \par History
473!> 09.2003 created [fawzi]
474!> \author Fawzi Mohamed
475! **************************************************************************************************
476 SUBROUTINE distribution_2d_get(distribution_2d, row_distribution, &
477 col_distribution, n_row_distribution, n_col_distribution, &
478 n_local_rows, n_local_cols, local_rows, local_cols, &
479 flat_local_rows, flat_local_cols, n_flat_local_rows, n_flat_local_cols, &
480 blacs_env)
481 TYPE(distribution_2d_type), POINTER :: distribution_2d
482 INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: row_distribution, col_distribution
483 INTEGER, INTENT(out), OPTIONAL :: n_row_distribution, n_col_distribution
484 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: n_local_rows, n_local_cols
485 TYPE(cp_1d_i_p_type), DIMENSION(:), OPTIONAL, &
486 POINTER :: local_rows, local_cols
487 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: flat_local_rows, flat_local_cols
488 INTEGER, INTENT(out), OPTIONAL :: n_flat_local_rows, n_flat_local_cols
489 TYPE(cp_blacs_env_type), OPTIONAL, POINTER :: blacs_env
490
491 INTEGER :: iblock_atomic, iblock_min, ikind, &
492 ikind_min
493 INTEGER, ALLOCATABLE, DIMENSION(:) :: multiindex
494
495 cpassert(ASSOCIATED(distribution_2d))
496 cpassert(distribution_2d%ref_count > 0)
497 IF (PRESENT(row_distribution)) row_distribution => distribution_2d%row_distribution
498 IF (PRESENT(col_distribution)) col_distribution => distribution_2d%col_distribution
499 IF (PRESENT(n_row_distribution)) n_row_distribution = distribution_2d%n_row_distribution
500 IF (PRESENT(n_col_distribution)) n_col_distribution = distribution_2d%n_col_distribution
501 IF (PRESENT(n_local_rows)) n_local_rows => distribution_2d%n_local_rows
502 IF (PRESENT(n_local_cols)) n_local_cols => distribution_2d%n_local_cols
503 IF (PRESENT(local_rows)) local_rows => distribution_2d%local_rows
504 IF (PRESENT(local_cols)) local_cols => distribution_2d%local_cols
505 IF (PRESENT(flat_local_rows)) THEN
506 IF (.NOT. ASSOCIATED(distribution_2d%flat_local_rows)) THEN
507 ALLOCATE (multiindex(SIZE(distribution_2d%local_rows)), &
508 distribution_2d%flat_local_rows(sum(distribution_2d%n_local_rows)))
509 multiindex = 1
510 DO iblock_atomic = 1, SIZE(distribution_2d%flat_local_rows)
511 iblock_min = huge(0)
512 ikind_min = -huge(0)
513 DO ikind = 1, SIZE(distribution_2d%local_rows)
514 IF (multiindex(ikind) <= distribution_2d%n_local_rows(ikind)) THEN
515 IF (distribution_2d%local_rows(ikind)%array(multiindex(ikind)) < &
516 iblock_min) THEN
517 iblock_min = distribution_2d%local_rows(ikind)%array(multiindex(ikind))
518 ikind_min = ikind
519 END IF
520 END IF
521 END DO
522 cpassert(ikind_min > 0)
523 distribution_2d%flat_local_rows(iblock_atomic) = &
524 distribution_2d%local_rows(ikind_min)%array(multiindex(ikind_min))
525 multiindex(ikind_min) = multiindex(ikind_min) + 1
526 END DO
527 DEALLOCATE (multiindex)
528 END IF
529 flat_local_rows => distribution_2d%flat_local_rows
530 END IF
531 IF (PRESENT(flat_local_cols)) THEN
532 IF (.NOT. ASSOCIATED(distribution_2d%flat_local_cols)) THEN
533 ALLOCATE (multiindex(SIZE(distribution_2d%local_cols)), &
534 distribution_2d%flat_local_cols(sum(distribution_2d%n_local_cols)))
535 multiindex = 1
536 DO iblock_atomic = 1, SIZE(distribution_2d%flat_local_cols)
537 iblock_min = huge(0)
538 ikind_min = -huge(0)
539 DO ikind = 1, SIZE(distribution_2d%local_cols)
540 IF (multiindex(ikind) <= distribution_2d%n_local_cols(ikind)) THEN
541 IF (distribution_2d%local_cols(ikind)%array(multiindex(ikind)) < &
542 iblock_min) THEN
543 iblock_min = distribution_2d%local_cols(ikind)%array(multiindex(ikind))
544 ikind_min = ikind
545 END IF
546 END IF
547 END DO
548 cpassert(ikind_min > 0)
549 distribution_2d%flat_local_cols(iblock_atomic) = &
550 distribution_2d%local_cols(ikind_min)%array(multiindex(ikind_min))
551 multiindex(ikind_min) = multiindex(ikind_min) + 1
552 END DO
553 DEALLOCATE (multiindex)
554 END IF
555 flat_local_cols => distribution_2d%flat_local_cols
556 END IF
557 IF (PRESENT(n_flat_local_rows)) n_flat_local_rows = sum(distribution_2d%n_local_rows)
558 IF (PRESENT(n_flat_local_cols)) n_flat_local_cols = sum(distribution_2d%n_local_cols)
559 IF (PRESENT(blacs_env)) blacs_env => distribution_2d%blacs_env
560 END SUBROUTINE distribution_2d_get
561
562END 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:117
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:732
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:282
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:230
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:481
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:288
distribution_2d_types::distribution_2d_retain
subroutine, public distribution_2d_retain(distribution_2d)
...
Definition distribution_2d_types.F:218
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:106
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