24 #include "base/base_uses.f90"
29 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'distribution_2d_types'
31 PUBLIC :: distribution_2d_type
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
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, &
111 INTEGER,
DIMENSION(:),
INTENT(in),
OPTIONAL :: n_local_cols
112 INTEGER,
INTENT(in),
OPTIONAL :: n_row_distribution, n_col_distribution
116 cpassert(
ASSOCIATED(blacs_env))
117 cpassert(.NOT.
ASSOCIATED(distribution_2d))
119 ALLOCATE (distribution_2d)
120 distribution_2d%ref_count = 1
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)
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)
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")
139 distribution_2d%n_col_distribution = n_col_distribution
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)
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")
152 distribution_2d%n_row_distribution = n_row_distribution
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)
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)
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)
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)
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)
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)
207 distribution_2d%blacs_env => blacs_env
208 CALL distribution_2d%blacs_env%retain()
218 TYPE(distribution_2d_type),
POINTER :: distribution_2d
220 cpassert(
ASSOCIATED(distribution_2d))
221 cpassert(distribution_2d%ref_count > 0)
222 distribution_2d%ref_count = distribution_2d%ref_count + 1
230 TYPE(distribution_2d_type),
POINTER :: distribution_2d
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
239 IF (
ASSOCIATED(distribution_2d%col_distribution))
THEN
240 DEALLOCATE (distribution_2d%col_distribution)
242 IF (
ASSOCIATED(distribution_2d%row_distribution))
THEN
243 DEALLOCATE (distribution_2d%row_distribution)
245 DO i = 1,
SIZE(distribution_2d%local_rows)
246 DEALLOCATE (distribution_2d%local_rows(i)%array)
248 DEALLOCATE (distribution_2d%local_rows)
249 DO i = 1,
SIZE(distribution_2d%local_cols)
250 DEALLOCATE (distribution_2d%local_cols(i)%array)
252 DEALLOCATE (distribution_2d%local_cols)
253 IF (
ASSOCIATED(distribution_2d%flat_local_rows))
THEN
254 DEALLOCATE (distribution_2d%flat_local_rows)
256 IF (
ASSOCIATED(distribution_2d%flat_local_cols))
THEN
257 DEALLOCATE (distribution_2d%flat_local_cols)
259 IF (
ASSOCIATED(distribution_2d%n_local_rows))
THEN
260 DEALLOCATE (distribution_2d%n_local_rows)
262 IF (
ASSOCIATED(distribution_2d%n_local_cols))
THEN
263 DEALLOCATE (distribution_2d%n_local_cols)
265 DEALLOCATE (distribution_2d)
268 NULLIFY (distribution_2d)
288 TYPE(distribution_2d_type),
POINTER :: distribution_2d
289 INTEGER,
INTENT(in) :: unit_nr
290 LOGICAL,
INTENT(in),
OPTIONAL :: local, long_description
293 LOGICAL :: my_local, my_long_description
294 TYPE(cp_logger_type),
POINTER :: logger
298 my_long_description = .false.
299 IF (
PRESENT(long_description)) my_long_description = long_description
301 IF (
PRESENT(local)) my_local = local
302 IF (.NOT. my_local) my_local = logger%para_env%is_source()
304 IF (
ASSOCIATED(distribution_2d))
THEN
306 WRITE (unit=unit_nr, &
307 fmt=
"(/,' <distribution_2d> { ref_count=',i10,',')") &
308 distribution_2d%ref_count
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)
318 IF (
modulo(i, 8) == 0 .AND. i .NE.
SIZE(distribution_2d%row_distribution, 1)) &
319 WRITE (unit=unit_nr, fmt=
'()')
321 WRITE (unit=unit_nr, fmt=
"('),')")
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))
328 WRITE (unit=unit_nr, fmt=
"(' row_distribution=*null*,')")
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)
339 IF (
modulo(i, 8) == 0 .AND. i .NE.
SIZE(distribution_2d%col_distribution, 1)) &
340 WRITE (unit=unit_nr, fmt=
'()')
342 WRITE (unit=unit_nr, fmt=
"('),')")
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))
349 WRITE (unit=unit_nr, fmt=
"(' col_distribution=*null*,')")
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)
358 IF (
modulo(i, 10) == 0 .AND. i .NE.
SIZE(distribution_2d%n_local_rows)) &
359 WRITE (unit=unit_nr, fmt=
'()')
361 WRITE (unit=unit_nr, fmt=
"('),')")
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)
368 WRITE (unit=unit_nr, fmt=
"(' n_local_rows=*null*,')")
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, &
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)
384 WRITE (unit=unit_nr, fmt=
"('*null*')")
387 WRITE (unit=unit_nr, fmt=
"(' ),')")
389 WRITE (unit=unit_nr, fmt=
"(' local_rows=*null*,')")
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)
398 IF (
modulo(i, 10) == 0 .AND. i .NE.
SIZE(distribution_2d%n_local_cols)) &
399 WRITE (unit=unit_nr, fmt=
'()')
401 WRITE (unit=unit_nr, fmt=
"('),')")
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)
408 WRITE (unit=unit_nr, fmt=
"(' n_local_cols=*null*,')")
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, &
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)
424 WRITE (unit=unit_nr, fmt=
"('*null*')")
427 WRITE (unit=unit_nr, fmt=
"(' ),')")
429 WRITE (unit=unit_nr, fmt=
"(' local_cols=*null*,')")
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)
437 WRITE (unit=unit_nr, fmt=
"(' blacs_env=<blacs_env id=',i6,'>')") &
438 distribution_2d%blacs_env%get_handle()
441 WRITE (unit=unit_nr, fmt=
"(' blacs_env=*null*')")
444 WRITE (unit=unit_nr, fmt=
"(' }')")
447 ELSE IF (my_local)
THEN
448 WRITE (unit=unit_nr, &
449 fmt=
"(' <distribution_2d *null*>')")
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, &
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
491 INTEGER :: iblock_atomic, iblock_min, ikind, &
493 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: multiindex
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)))
510 DO iblock_atomic = 1,
SIZE(distribution_2d%flat_local_rows)
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)) < &
517 iblock_min = distribution_2d%local_rows(ikind)%array(multiindex(ikind))
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
527 DEALLOCATE (multiindex)
529 flat_local_rows => distribution_2d%flat_local_rows
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)))
536 DO iblock_atomic = 1,
SIZE(distribution_2d%flat_local_cols)
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)) < &
543 iblock_min = distribution_2d%local_cols(ikind)%array(multiindex(ikind))
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
553 DEALLOCATE (multiindex)
555 flat_local_cols => distribution_2d%flat_local_cols
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
static GRID_HOST_DEVICE int modulo(int a, int m)
Equivalent of Fortran's MODULO, which always return a positive number. https://gcc....
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
subroutine, public cp_blacs_env_release(blacs_env)
releases the given blacs_env
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.
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly