(git:58e3e09)
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 ! **************************************************************************************************
16 
17  USE cp_array_utils, ONLY: cp_1d_i_p_type,&
20  cp_blacs_env_type
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, &
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 
77 CONTAINS
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 
562 END MODULE distribution_2d_types
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
various utilities that regard array of different kinds: output, allocation,... maybe it is not a good...
subroutine, public cp_1d_i_write(array, unit_nr, el_format)
writes an array to the given unit
methods related to the blacs parallel environment
Definition: cp_blacs_env.F:15
subroutine, public cp_blacs_env_release(blacs_env)
releases the given blacs_env
Definition: cp_blacs_env.F:282
various routines to log and control the output. The idea is that decisions about where to log should ...
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
stores a mapping of 2D info (e.g. matrix) on a 2D processor distribution (i.e. blacs grid) where cpus...
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
subroutine, public distribution_2d_release(distribution_2d)
...
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
subroutine, public distribution_2d_write(distribution_2d, unit_nr, local, long_description)
writes out the given distribution
subroutine, public distribution_2d_retain(distribution_2d)
...
Machine interface based on Fortran 2003 and POSIX.
Definition: machine.F:17
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
Definition: machine.F:106