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