Line data Source code
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 : ! **************************************************************************************************
15 : MODULE 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 :
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 21921 : SUBROUTINE distribution_2d_create(distribution_2d, blacs_env, &
99 21921 : local_rows_ptr, n_local_rows, &
100 : local_cols_ptr, row_distribution_ptr, col_distribution_ptr, &
101 21921 : 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 21921 : CPASSERT(ASSOCIATED(blacs_env))
117 21921 : CPASSERT(.NOT. ASSOCIATED(distribution_2d))
118 :
119 21921 : ALLOCATE (distribution_2d)
120 21921 : 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 21921 : distribution_2d%n_col_distribution = -HUGE(0)
129 21921 : IF (PRESENT(col_distribution_ptr)) THEN
130 21921 : distribution_2d%col_distribution => col_distribution_ptr
131 21921 : distribution_2d%n_col_distribution = SIZE(distribution_2d%col_distribution, 1)
132 : END IF
133 21921 : IF (PRESENT(n_col_distribution)) THEN
134 0 : IF (ASSOCIATED(distribution_2d%col_distribution)) THEN
135 0 : IF (n_col_distribution > distribution_2d%n_col_distribution) THEN
136 0 : CPABORT("n_col_distribution<=distribution_2d%n_col_distribution")
137 : END IF
138 : ! else alloc col_distribution?
139 : END IF
140 0 : distribution_2d%n_col_distribution = n_col_distribution
141 : END IF
142 21921 : distribution_2d%n_row_distribution = -HUGE(0)
143 21921 : IF (PRESENT(row_distribution_ptr)) THEN
144 21921 : distribution_2d%row_distribution => row_distribution_ptr
145 21921 : distribution_2d%n_row_distribution = SIZE(distribution_2d%row_distribution, 1)
146 : END IF
147 21921 : IF (PRESENT(n_row_distribution)) THEN
148 0 : IF (ASSOCIATED(distribution_2d%row_distribution)) THEN
149 0 : IF (n_row_distribution > distribution_2d%n_row_distribution) THEN
150 0 : CPABORT("n_row_distribution<=distribution_2d%n_row_distribution")
151 : END IF
152 : ! else alloc row_distribution?
153 : END IF
154 0 : distribution_2d%n_row_distribution = n_row_distribution
155 : END IF
156 :
157 21921 : IF (PRESENT(local_rows_ptr)) THEN
158 21921 : distribution_2d%local_rows => local_rows_ptr
159 : END IF
160 21921 : IF (.NOT. ASSOCIATED(distribution_2d%local_rows)) THEN
161 0 : CPASSERT(PRESENT(n_local_rows))
162 0 : ALLOCATE (distribution_2d%local_rows(SIZE(n_local_rows)))
163 0 : DO i = 1, SIZE(distribution_2d%local_rows)
164 0 : ALLOCATE (distribution_2d%local_rows(i)%array(n_local_rows(i)))
165 0 : distribution_2d%local_rows(i)%array = -HUGE(0)
166 : END DO
167 : END IF
168 65763 : ALLOCATE (distribution_2d%n_local_rows(SIZE(distribution_2d%local_rows)))
169 21921 : IF (PRESENT(n_local_rows)) THEN
170 0 : IF (SIZE(distribution_2d%n_local_rows) /= SIZE(n_local_rows)) THEN
171 0 : CPABORT("SIZE(distribution_2d%n_local_rows)==SIZE(n_local_rows)")
172 : END IF
173 0 : DO i = 1, SIZE(distribution_2d%n_local_rows)
174 0 : IF (SIZE(distribution_2d%local_rows(i)%array) < n_local_rows(i)) THEN
175 0 : CPABORT("SIZE(distribution_2d%local_rows(i)%array)>=n_local_rows(i)")
176 : END IF
177 0 : distribution_2d%n_local_rows(i) = n_local_rows(i)
178 : END DO
179 : ELSE
180 58478 : DO i = 1, SIZE(distribution_2d%n_local_rows)
181 : distribution_2d%n_local_rows(i) = &
182 58478 : SIZE(distribution_2d%local_rows(i)%array)
183 : END DO
184 : END IF
185 :
186 21921 : IF (PRESENT(local_cols_ptr)) THEN
187 21921 : distribution_2d%local_cols => local_cols_ptr
188 : END IF
189 21921 : IF (.NOT. ASSOCIATED(distribution_2d%local_cols)) THEN
190 0 : CPASSERT(PRESENT(n_local_cols))
191 0 : ALLOCATE (distribution_2d%local_cols(SIZE(n_local_cols)))
192 0 : DO i = 1, SIZE(distribution_2d%local_cols)
193 0 : ALLOCATE (distribution_2d%local_cols(i)%array(n_local_cols(i)))
194 0 : distribution_2d%local_cols(i)%array = -HUGE(0)
195 : END DO
196 : END IF
197 65763 : ALLOCATE (distribution_2d%n_local_cols(SIZE(distribution_2d%local_cols)))
198 21921 : IF (PRESENT(n_local_cols)) THEN
199 0 : IF (SIZE(distribution_2d%n_local_cols) /= SIZE(n_local_cols)) THEN
200 0 : CPABORT("SIZE(distribution_2d%n_local_cols)==SIZE(n_local_cols)")
201 : END IF
202 0 : DO i = 1, SIZE(distribution_2d%n_local_cols)
203 0 : IF (SIZE(distribution_2d%local_cols(i)%array) < n_local_cols(i)) THEN
204 0 : CPABORT("SIZE(distribution_2d%local_cols(i)%array)>=n_local_cols(i)")
205 : END IF
206 0 : distribution_2d%n_local_cols(i) = n_local_cols(i)
207 : END DO
208 : ELSE
209 58478 : DO i = 1, SIZE(distribution_2d%n_local_cols)
210 : distribution_2d%n_local_cols(i) = &
211 58478 : SIZE(distribution_2d%local_cols(i)%array)
212 : END DO
213 : END IF
214 :
215 21921 : distribution_2d%blacs_env => blacs_env
216 21921 : CALL distribution_2d%blacs_env%retain()
217 :
218 21921 : END SUBROUTINE distribution_2d_create
219 :
220 : ! **************************************************************************************************
221 : !> \brief ...
222 : !> \param distribution_2d ...
223 : !> \author Joost VandeVondele
224 : ! **************************************************************************************************
225 8664 : SUBROUTINE distribution_2d_retain(distribution_2d)
226 : TYPE(distribution_2d_type), POINTER :: distribution_2d
227 :
228 8664 : CPASSERT(ASSOCIATED(distribution_2d))
229 8664 : CPASSERT(distribution_2d%ref_count > 0)
230 8664 : distribution_2d%ref_count = distribution_2d%ref_count + 1
231 8664 : END SUBROUTINE distribution_2d_retain
232 :
233 : ! **************************************************************************************************
234 : !> \brief ...
235 : !> \param distribution_2d ...
236 : ! **************************************************************************************************
237 39249 : SUBROUTINE distribution_2d_release(distribution_2d)
238 : TYPE(distribution_2d_type), POINTER :: distribution_2d
239 :
240 : INTEGER :: i
241 :
242 39249 : IF (ASSOCIATED(distribution_2d)) THEN
243 30585 : CPASSERT(distribution_2d%ref_count > 0)
244 30585 : distribution_2d%ref_count = distribution_2d%ref_count - 1
245 30585 : IF (distribution_2d%ref_count == 0) THEN
246 21921 : CALL cp_blacs_env_release(distribution_2d%blacs_env)
247 21921 : IF (ASSOCIATED(distribution_2d%col_distribution)) THEN
248 21921 : DEALLOCATE (distribution_2d%col_distribution)
249 : END IF
250 21921 : IF (ASSOCIATED(distribution_2d%row_distribution)) THEN
251 21921 : DEALLOCATE (distribution_2d%row_distribution)
252 : END IF
253 58478 : DO i = 1, SIZE(distribution_2d%local_rows)
254 58478 : DEALLOCATE (distribution_2d%local_rows(i)%array)
255 : END DO
256 21921 : DEALLOCATE (distribution_2d%local_rows)
257 58478 : DO i = 1, SIZE(distribution_2d%local_cols)
258 58478 : DEALLOCATE (distribution_2d%local_cols(i)%array)
259 : END DO
260 21921 : DEALLOCATE (distribution_2d%local_cols)
261 21921 : IF (ASSOCIATED(distribution_2d%flat_local_rows)) THEN
262 0 : DEALLOCATE (distribution_2d%flat_local_rows)
263 : END IF
264 21921 : IF (ASSOCIATED(distribution_2d%flat_local_cols)) THEN
265 0 : DEALLOCATE (distribution_2d%flat_local_cols)
266 : END IF
267 21921 : IF (ASSOCIATED(distribution_2d%n_local_rows)) THEN
268 21921 : DEALLOCATE (distribution_2d%n_local_rows)
269 : END IF
270 21921 : IF (ASSOCIATED(distribution_2d%n_local_cols)) THEN
271 21921 : DEALLOCATE (distribution_2d%n_local_cols)
272 : END IF
273 21921 : DEALLOCATE (distribution_2d)
274 : END IF
275 : END IF
276 39249 : NULLIFY (distribution_2d)
277 39249 : 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 98 : 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 98 : logger => cp_get_default_logger()
305 :
306 98 : my_long_description = .FALSE.
307 98 : IF (PRESENT(long_description)) my_long_description = long_description
308 98 : my_local = .FALSE.
309 98 : IF (PRESENT(local)) my_local = local
310 98 : IF (.NOT. my_local) my_local = logger%para_env%is_source()
311 :
312 98 : IF (ASSOCIATED(distribution_2d)) THEN
313 98 : IF (my_local) THEN
314 : WRITE (unit=unit_nr, &
315 : fmt="(/,' <distribution_2d> { ref_count=',i10,',')") &
316 98 : distribution_2d%ref_count
317 :
318 : WRITE (unit=unit_nr, fmt="(' n_row_distribution=',i15,',')") &
319 98 : distribution_2d%n_row_distribution
320 98 : IF (ASSOCIATED(distribution_2d%row_distribution)) THEN
321 98 : IF (my_long_description) THEN
322 98 : WRITE (unit=unit_nr, fmt="(' row_distribution= (')", advance="no")
323 758 : DO i = 1, SIZE(distribution_2d%row_distribution, 1)
324 660 : 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 758 : IF (MODULO(i, 8) == 0 .AND. i /= SIZE(distribution_2d%row_distribution, 1)) THEN
327 38 : WRITE (unit=unit_nr, fmt='()')
328 : END IF
329 : END DO
330 98 : WRITE (unit=unit_nr, fmt="('),')")
331 : ELSE
332 : WRITE (unit=unit_nr, fmt="(' row_distribution= array(',i6,':',i6,'),')") &
333 0 : LBOUND(distribution_2d%row_distribution(:, 1)), &
334 0 : UBOUND(distribution_2d%row_distribution(:, 1))
335 : END IF
336 : ELSE
337 0 : WRITE (unit=unit_nr, fmt="(' row_distribution=*null*,')")
338 : END IF
339 :
340 : WRITE (unit=unit_nr, fmt="(' n_col_distribution=',i15,',')") &
341 98 : distribution_2d%n_col_distribution
342 98 : IF (ASSOCIATED(distribution_2d%col_distribution)) THEN
343 98 : IF (my_long_description) THEN
344 98 : WRITE (unit=unit_nr, fmt="(' col_distribution= (')", advance="no")
345 758 : DO i = 1, SIZE(distribution_2d%col_distribution, 1)
346 660 : 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 758 : IF (MODULO(i, 8) == 0 .AND. i /= SIZE(distribution_2d%col_distribution, 1)) THEN
349 38 : WRITE (unit=unit_nr, fmt='()')
350 : END IF
351 : END DO
352 98 : WRITE (unit=unit_nr, fmt="('),')")
353 : ELSE
354 : WRITE (unit=unit_nr, fmt="(' col_distribution= array(',i6,':',i6,'),')") &
355 0 : LBOUND(distribution_2d%col_distribution(:, 1)), &
356 0 : UBOUND(distribution_2d%col_distribution(:, 1))
357 : END IF
358 : ELSE
359 0 : WRITE (unit=unit_nr, fmt="(' col_distribution=*null*,')")
360 : END IF
361 :
362 98 : IF (ASSOCIATED(distribution_2d%n_local_rows)) THEN
363 98 : IF (my_long_description) THEN
364 98 : WRITE (unit=unit_nr, fmt="(' n_local_rows= (')", advance="no")
365 272 : DO i = 1, SIZE(distribution_2d%n_local_rows)
366 174 : 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 272 : IF (MODULO(i, 10) == 0 .AND. i /= SIZE(distribution_2d%n_local_rows)) THEN
369 0 : WRITE (unit=unit_nr, fmt='()')
370 : END IF
371 : END DO
372 98 : WRITE (unit=unit_nr, fmt="('),')")
373 : ELSE
374 : WRITE (unit=unit_nr, fmt="(' n_local_rows= array(',i6,':',i6,'),')") &
375 0 : LBOUND(distribution_2d%n_local_rows), &
376 0 : UBOUND(distribution_2d%n_local_rows)
377 : END IF
378 : ELSE
379 0 : WRITE (unit=unit_nr, fmt="(' n_local_rows=*null*,')")
380 : END IF
381 :
382 98 : IF (ASSOCIATED(distribution_2d%local_rows)) THEN
383 98 : WRITE (unit=unit_nr, fmt="(' local_rows=(')")
384 272 : DO i = 1, SIZE(distribution_2d%local_rows)
385 272 : IF (ASSOCIATED(distribution_2d%local_rows(i)%array)) THEN
386 174 : IF (my_long_description) THEN
387 : CALL cp_1d_i_write(array=distribution_2d%local_rows(i)%array, &
388 174 : unit_nr=unit_nr)
389 : ELSE
390 : WRITE (unit=unit_nr, fmt="(' array(',i6,':',i6,'),')") &
391 0 : LBOUND(distribution_2d%local_rows(i)%array), &
392 0 : UBOUND(distribution_2d%local_rows(i)%array)
393 : END IF
394 : ELSE
395 0 : WRITE (unit=unit_nr, fmt="('*null*')")
396 : END IF
397 : END DO
398 98 : WRITE (unit=unit_nr, fmt="(' ),')")
399 : ELSE
400 0 : WRITE (unit=unit_nr, fmt="(' local_rows=*null*,')")
401 : END IF
402 :
403 98 : IF (ASSOCIATED(distribution_2d%n_local_cols)) THEN
404 98 : IF (my_long_description) THEN
405 98 : WRITE (unit=unit_nr, fmt="(' n_local_cols= (')", advance="no")
406 272 : DO i = 1, SIZE(distribution_2d%n_local_cols)
407 174 : 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 272 : IF (MODULO(i, 10) == 0 .AND. i /= SIZE(distribution_2d%n_local_cols)) THEN
410 0 : WRITE (unit=unit_nr, fmt='()')
411 : END IF
412 : END DO
413 98 : WRITE (unit=unit_nr, fmt="('),')")
414 : ELSE
415 : WRITE (unit=unit_nr, fmt="(' n_local_cols= array(',i6,':',i6,'),')") &
416 0 : LBOUND(distribution_2d%n_local_cols), &
417 0 : UBOUND(distribution_2d%n_local_cols)
418 : END IF
419 : ELSE
420 0 : WRITE (unit=unit_nr, fmt="(' n_local_cols=*null*,')")
421 : END IF
422 :
423 98 : IF (ASSOCIATED(distribution_2d%local_cols)) THEN
424 98 : WRITE (unit=unit_nr, fmt="(' local_cols=(')")
425 272 : DO i = 1, SIZE(distribution_2d%local_cols)
426 272 : IF (ASSOCIATED(distribution_2d%local_cols(i)%array)) THEN
427 174 : IF (my_long_description) THEN
428 : CALL cp_1d_i_write(array=distribution_2d%local_cols(i)%array, &
429 174 : unit_nr=unit_nr)
430 : ELSE
431 : WRITE (unit=unit_nr, fmt="(' array(',i6,':',i6,'),')") &
432 0 : LBOUND(distribution_2d%local_cols(i)%array), &
433 0 : UBOUND(distribution_2d%local_cols(i)%array)
434 : END IF
435 : ELSE
436 0 : WRITE (unit=unit_nr, fmt="('*null*')")
437 : END IF
438 : END DO
439 98 : WRITE (unit=unit_nr, fmt="(' ),')")
440 : ELSE
441 0 : WRITE (unit=unit_nr, fmt="(' local_cols=*null*,')")
442 : END IF
443 :
444 98 : IF (ASSOCIATED(distribution_2d%blacs_env)) THEN
445 98 : IF (my_long_description) THEN
446 98 : WRITE (unit=unit_nr, fmt="(' blacs_env=')", advance="no")
447 98 : CALL distribution_2d%blacs_env%write(unit_nr)
448 : ELSE
449 : WRITE (unit=unit_nr, fmt="(' blacs_env=<blacs_env id=',i6,'>')") &
450 0 : distribution_2d%blacs_env%get_handle()
451 : END IF
452 : ELSE
453 0 : WRITE (unit=unit_nr, fmt="(' blacs_env=*null*')")
454 : END IF
455 :
456 98 : WRITE (unit=unit_nr, fmt="(' }')")
457 : END IF
458 :
459 0 : ELSE IF (my_local) THEN
460 : WRITE (unit=unit_nr, &
461 0 : fmt="(' <distribution_2d *null*>')")
462 : END IF
463 :
464 98 : CALL m_flush(unit_nr)
465 :
466 98 : 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 11164 : 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 11164 : INTEGER, ALLOCATABLE, DIMENSION(:) :: multiindex
506 :
507 11164 : CPASSERT(ASSOCIATED(distribution_2d))
508 11164 : CPASSERT(distribution_2d%ref_count > 0)
509 11164 : IF (PRESENT(row_distribution)) row_distribution => distribution_2d%row_distribution
510 11164 : IF (PRESENT(col_distribution)) col_distribution => distribution_2d%col_distribution
511 11164 : IF (PRESENT(n_row_distribution)) n_row_distribution = distribution_2d%n_row_distribution
512 11164 : IF (PRESENT(n_col_distribution)) n_col_distribution = distribution_2d%n_col_distribution
513 11164 : IF (PRESENT(n_local_rows)) n_local_rows => distribution_2d%n_local_rows
514 11164 : IF (PRESENT(n_local_cols)) n_local_cols => distribution_2d%n_local_cols
515 11164 : IF (PRESENT(local_rows)) local_rows => distribution_2d%local_rows
516 11164 : IF (PRESENT(local_cols)) local_cols => distribution_2d%local_cols
517 11164 : IF (PRESENT(flat_local_rows)) THEN
518 0 : IF (.NOT. ASSOCIATED(distribution_2d%flat_local_rows)) THEN
519 : ALLOCATE (multiindex(SIZE(distribution_2d%local_rows)), &
520 0 : distribution_2d%flat_local_rows(SUM(distribution_2d%n_local_rows)))
521 0 : multiindex = 1
522 0 : DO iblock_atomic = 1, SIZE(distribution_2d%flat_local_rows)
523 0 : iblock_min = HUGE(0)
524 0 : ikind_min = -HUGE(0)
525 0 : DO ikind = 1, SIZE(distribution_2d%local_rows)
526 0 : IF (multiindex(ikind) <= distribution_2d%n_local_rows(ikind)) THEN
527 0 : IF (distribution_2d%local_rows(ikind)%array(multiindex(ikind)) < &
528 : iblock_min) THEN
529 0 : iblock_min = distribution_2d%local_rows(ikind)%array(multiindex(ikind))
530 0 : ikind_min = ikind
531 : END IF
532 : END IF
533 : END DO
534 0 : CPASSERT(ikind_min > 0)
535 : distribution_2d%flat_local_rows(iblock_atomic) = &
536 0 : distribution_2d%local_rows(ikind_min)%array(multiindex(ikind_min))
537 0 : multiindex(ikind_min) = multiindex(ikind_min) + 1
538 : END DO
539 0 : DEALLOCATE (multiindex)
540 : END IF
541 0 : flat_local_rows => distribution_2d%flat_local_rows
542 : END IF
543 11164 : IF (PRESENT(flat_local_cols)) THEN
544 0 : IF (.NOT. ASSOCIATED(distribution_2d%flat_local_cols)) THEN
545 : ALLOCATE (multiindex(SIZE(distribution_2d%local_cols)), &
546 0 : distribution_2d%flat_local_cols(SUM(distribution_2d%n_local_cols)))
547 0 : multiindex = 1
548 0 : DO iblock_atomic = 1, SIZE(distribution_2d%flat_local_cols)
549 0 : iblock_min = HUGE(0)
550 0 : ikind_min = -HUGE(0)
551 0 : DO ikind = 1, SIZE(distribution_2d%local_cols)
552 0 : IF (multiindex(ikind) <= distribution_2d%n_local_cols(ikind)) THEN
553 0 : IF (distribution_2d%local_cols(ikind)%array(multiindex(ikind)) < &
554 : iblock_min) THEN
555 0 : iblock_min = distribution_2d%local_cols(ikind)%array(multiindex(ikind))
556 0 : ikind_min = ikind
557 : END IF
558 : END IF
559 : END DO
560 0 : CPASSERT(ikind_min > 0)
561 : distribution_2d%flat_local_cols(iblock_atomic) = &
562 0 : distribution_2d%local_cols(ikind_min)%array(multiindex(ikind_min))
563 0 : multiindex(ikind_min) = multiindex(ikind_min) + 1
564 : END DO
565 0 : DEALLOCATE (multiindex)
566 : END IF
567 0 : flat_local_cols => distribution_2d%flat_local_cols
568 : END IF
569 11164 : IF (PRESENT(n_flat_local_rows)) n_flat_local_rows = SUM(distribution_2d%n_local_rows)
570 11164 : IF (PRESENT(n_flat_local_cols)) n_flat_local_cols = SUM(distribution_2d%n_local_cols)
571 11164 : IF (PRESENT(blacs_env)) blacs_env => distribution_2d%blacs_env
572 11164 : END SUBROUTINE distribution_2d_get
573 :
574 0 : END MODULE distribution_2d_types
|
