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 Tall-and-skinny matrices: base routines similar to DBM API,
10 : !> mostly wrappers around existing DBM routines.
11 : !> \author Patrick Seewald
12 : ! **************************************************************************************************
13 : MODULE dbt_tas_base
14 : USE dbm_api, ONLY: &
15 : dbm_clear, dbm_create, dbm_create_from_template, dbm_distribution_col_dist, &
16 : dbm_distribution_hold, dbm_distribution_new, dbm_distribution_obj, &
17 : dbm_distribution_release, dbm_distribution_row_dist, dbm_filter, dbm_finalize, &
18 : dbm_get_block_p, dbm_get_col_block_sizes, dbm_get_distribution, dbm_get_local_cols, &
19 : dbm_get_local_rows, dbm_get_name, dbm_get_num_blocks, dbm_get_nze, &
20 : dbm_get_row_block_sizes, dbm_iterator, dbm_iterator_blocks_left, dbm_iterator_next_block, &
21 : dbm_iterator_num_blocks, dbm_iterator_start, dbm_iterator_stop, dbm_put_block, &
22 : dbm_release, dbm_reserve_blocks, dbm_type
23 : USE dbt_tas_global, ONLY: dbt_tas_blk_size_arb,&
24 : dbt_tas_dist_arb,&
25 : dbt_tas_distribution,&
26 : dbt_tas_rowcol_data
27 : USE dbt_tas_split, ONLY: colsplit,&
28 : dbt_index_global_to_local,&
29 : dbt_index_local_to_global,&
30 : dbt_tas_create_split,&
31 : dbt_tas_info_hold,&
32 : dbt_tas_release_info,&
33 : group_to_mrowcol,&
34 : rowsplit
35 : USE dbt_tas_types, ONLY: dbt_tas_distribution_type,&
36 : dbt_tas_iterator,&
37 : dbt_tas_split_info,&
38 : dbt_tas_type
39 : USE kinds, ONLY: default_string_length,&
40 : dp,&
41 : int_8
42 : USE message_passing, ONLY: mp_cart_type
43 : #include "../../base/base_uses.f90"
44 :
45 : IMPLICIT NONE
46 : PRIVATE
47 :
48 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'dbt_tas_base'
49 :
50 : ! DBM wrappers / interface routines
51 : PUBLIC :: &
52 : dbt_tas_blk_sizes, &
53 : dbt_tas_clear, &
54 : dbt_tas_copy, &
55 : dbt_tas_create, &
56 : dbt_tas_destroy, &
57 : dbt_tas_distribution_destroy, &
58 : dbt_tas_distribution_new, &
59 : dbt_tas_filter, &
60 : dbt_tas_finalize, &
61 : dbt_tas_get_block_p, &
62 : dbt_tas_get_info, &
63 : dbt_tas_get_num_blocks, &
64 : dbt_tas_get_nze, &
65 : dbt_tas_get_nze_total, &
66 : dbt_tas_get_num_blocks_total, &
67 : dbt_tas_get_stored_coordinates, &
68 : dbt_tas_info, &
69 : dbt_tas_iterator_num_blocks, &
70 : dbt_tas_iterator_blocks_left, &
71 : dbt_tas_iterator_next_block, &
72 : dbt_tas_iterator_start, &
73 : dbt_tas_iterator_stop, &
74 : dbt_tas_nblkcols_local, &
75 : dbt_tas_nblkcols_total, &
76 : dbt_tas_nblkrows_local, &
77 : dbt_tas_nblkrows_total, &
78 : dbt_tas_nfullrows_total, &
79 : dbt_tas_nfullcols_total, &
80 : dbt_tas_put_block, &
81 : dbt_tas_reserve_blocks, &
82 : dbt_repl_get_stored_coordinates
83 :
84 : ! conversion routines
85 : PUBLIC :: &
86 : dbt_tas_convert_to_dbm, &
87 : dbt_tas_convert_to_tas
88 :
89 : INTERFACE dbt_tas_create
90 : MODULE PROCEDURE dbt_tas_create_new
91 : MODULE PROCEDURE dbt_tas_create_template
92 : END INTERFACE
93 :
94 : INTERFACE dbt_tas_reserve_blocks
95 : MODULE PROCEDURE dbt_tas_reserve_blocks_template
96 : MODULE PROCEDURE dbt_tas_reserve_blocks_index
97 : END INTERFACE
98 :
99 : INTERFACE dbt_tas_iterator_next_block
100 : MODULE PROCEDURE dbt_tas_iterator_next_block_d
101 : MODULE PROCEDURE dbt_tas_iterator_next_block_index
102 : END INTERFACE
103 :
104 : CONTAINS
105 :
106 : ! **************************************************************************************************
107 : !> \brief Create new tall-and-skinny matrix.
108 : !> Exactly like dbt_create_new but with custom types for row_blk_size and col_blk_size
109 : !> instead of arrays.
110 : !> \param matrix ...
111 : !> \param name ...
112 : !> \param dist ...
113 : !> \param row_blk_size ...
114 : !> \param col_blk_size ...
115 : !> \param own_dist whether matrix should own distribution
116 : !> \author Patrick Seewald
117 : ! **************************************************************************************************
118 5892180 : SUBROUTINE dbt_tas_create_new(matrix, name, dist, row_blk_size, col_blk_size, own_dist)
119 : TYPE(dbt_tas_type), INTENT(OUT) :: matrix
120 : CHARACTER(len=*), INTENT(IN) :: name
121 : TYPE(dbt_tas_distribution_type), INTENT(INOUT) :: dist
122 :
123 : CLASS(dbt_tas_rowcol_data), INTENT(IN) :: row_blk_size, col_blk_size
124 : LOGICAL, INTENT(IN), OPTIONAL :: own_dist
125 :
126 : TYPE(dbt_tas_split_info), POINTER :: info
127 :
128 841740 : INTEGER, DIMENSION(:), POINTER, CONTIGUOUS :: row_blk_size_vec, col_blk_size_vec
129 : INTEGER :: nrows, ncols, irow, col, icol, row
130 : CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_tas_create_new'
131 : INTEGER :: handle
132 :
133 841740 : CALL timeset(routineN, handle)
134 :
135 841740 : CALL dbt_tas_copy_distribution(dist, matrix%dist, own_dist)
136 841740 : matrix%nblkrows = row_blk_size%nmrowcol
137 841740 : matrix%nblkcols = col_blk_size%nmrowcol
138 :
139 841740 : CPASSERT(matrix%nblkrows == dist%row_dist%nmrowcol)
140 841740 : CPASSERT(matrix%nblkcols == dist%col_dist%nmrowcol)
141 :
142 841740 : matrix%nfullrows = row_blk_size%nfullrowcol
143 841740 : matrix%nfullcols = col_blk_size%nfullrowcol
144 :
145 841740 : ALLOCATE (matrix%row_blk_size, source=row_blk_size)
146 841740 : ALLOCATE (matrix%col_blk_size, source=col_blk_size)
147 :
148 841740 : info => dbt_tas_info(matrix)
149 :
150 1521522 : SELECT CASE (info%split_rowcol)
151 : CASE (rowsplit)
152 679782 : matrix%nblkrowscols_split = matrix%nblkrows
153 :
154 679782 : ASSOCIATE (rows => dist%local_rowcols)
155 679782 : nrows = SIZE(rows)
156 679782 : ncols = INT(dist%col_dist%nmrowcol)
157 2039026 : ALLOCATE (row_blk_size_vec(nrows))
158 2039346 : ALLOCATE (col_blk_size_vec(ncols))
159 5139876 : DO irow = 1, nrows
160 5139876 : row_blk_size_vec(irow) = row_blk_size%data(rows(irow))
161 : END DO
162 4906907 : DO col = 1, ncols
163 4227125 : col_blk_size_vec(col) = col_blk_size%data(INT(col, KIND=int_8))
164 : END DO
165 : END ASSOCIATE
166 : CASE (colsplit)
167 161958 : matrix%nblkrowscols_split = matrix%nblkcols
168 :
169 841740 : ASSOCIATE (cols => dist%local_rowcols)
170 161958 : ncols = SIZE(cols)
171 161958 : nrows = INT(dist%row_dist%nmrowcol)
172 485874 : ALLOCATE (row_blk_size_vec(nrows))
173 485122 : ALLOCATE (col_blk_size_vec(ncols))
174 6479106 : DO icol = 1, ncols
175 6479106 : col_blk_size_vec(icol) = col_blk_size%data(cols(icol))
176 : END DO
177 1452881 : DO row = 1, nrows
178 1290923 : row_blk_size_vec(row) = row_blk_size%data(INT(row, KIND=int_8))
179 : END DO
180 : END ASSOCIATE
181 : END SELECT
182 :
183 : CALL dbm_create(matrix=matrix%matrix, &
184 : name=name, &
185 : dist=dist%dbm_dist, &
186 : row_block_sizes=row_blk_size_vec, &
187 841740 : col_block_sizes=col_blk_size_vec)
188 :
189 841740 : DEALLOCATE (row_blk_size_vec, col_blk_size_vec)
190 841740 : matrix%valid = .TRUE.
191 841740 : CALL timestop(handle)
192 :
193 841740 : END SUBROUTINE
194 :
195 : ! **************************************************************************************************
196 : !> \brief Create matrix from template
197 : !> \param matrix_in ...
198 : !> \param matrix ...
199 : !> \param name ...
200 : !> \author Patrick Seewald
201 : ! **************************************************************************************************
202 1934548 : SUBROUTINE dbt_tas_create_template(matrix_in, matrix, name)
203 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix_in
204 : TYPE(dbt_tas_type), INTENT(OUT) :: matrix
205 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: name
206 :
207 276364 : IF (PRESENT(name)) THEN
208 276352 : CALL dbm_create_from_template(matrix%matrix, name=name, template=matrix_in%matrix)
209 : ELSE
210 : CALL dbm_create_from_template(matrix%matrix, name=dbm_get_name(matrix_in%matrix), &
211 12 : template=matrix_in%matrix)
212 : END IF
213 276364 : CALL dbm_finalize(matrix%matrix)
214 :
215 276364 : CALL dbt_tas_copy_distribution(matrix_in%dist, matrix%dist)
216 276364 : ALLOCATE (matrix%row_blk_size, source=matrix_in%row_blk_size)
217 276364 : ALLOCATE (matrix%col_blk_size, source=matrix_in%col_blk_size)
218 276364 : matrix%nblkrows = matrix_in%nblkrows
219 276364 : matrix%nblkcols = matrix_in%nblkcols
220 276364 : matrix%nblkrowscols_split = matrix_in%nblkrowscols_split
221 276364 : matrix%nfullrows = matrix_in%nfullrows
222 276364 : matrix%nfullcols = matrix_in%nfullcols
223 276364 : matrix%valid = .TRUE.
224 :
225 276364 : END SUBROUTINE
226 :
227 : ! **************************************************************************************************
228 : !> \brief ...
229 : !> \param matrix ...
230 : !> \author Patrick Seewald
231 : ! **************************************************************************************************
232 1118104 : SUBROUTINE dbt_tas_destroy(matrix)
233 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
234 :
235 1118104 : CALL dbm_release(matrix%matrix)
236 1118104 : CALL dbt_tas_distribution_destroy(matrix%dist)
237 1118104 : DEALLOCATE (matrix%row_blk_size)
238 1118104 : DEALLOCATE (matrix%col_blk_size)
239 1118104 : matrix%valid = .FALSE.
240 1118104 : END SUBROUTINE
241 :
242 : ! **************************************************************************************************
243 : !> \brief Copy matrix_a to matrix_b
244 : !> \param matrix_b ...
245 : !> \param matrix_a ...
246 : !> \param summation Whether to sum matrices b = a + b
247 : !> \author Patrick Seewald
248 : ! **************************************************************************************************
249 230960 : SUBROUTINE dbt_tas_copy(matrix_b, matrix_a, summation)
250 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix_b
251 : TYPE(dbt_tas_type), INTENT(IN) :: matrix_a
252 : LOGICAL, INTENT(IN), OPTIONAL :: summation
253 :
254 : CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_tas_copy'
255 :
256 : INTEGER :: handle
257 : INTEGER(KIND=int_8) :: column, row
258 230960 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: block
259 : TYPE(dbt_tas_iterator) :: iter
260 :
261 230960 : CALL timeset(routineN, handle)
262 230960 : CPASSERT(matrix_b%valid)
263 :
264 230960 : IF (PRESENT(summation)) THEN
265 38490 : IF (.NOT. summation) CALL dbt_tas_clear(matrix_b)
266 : ELSE
267 192470 : CALL dbt_tas_clear(matrix_b)
268 : END IF
269 :
270 230960 : CALL dbt_tas_reserve_blocks(matrix_a, matrix_b)
271 :
272 : !$OMP PARALLEL DEFAULT(NONE) SHARED(matrix_a,matrix_b,summation) &
273 230960 : !$OMP PRIVATE(iter,row,column,block)
274 : CALL dbt_tas_iterator_start(iter, matrix_a)
275 : DO WHILE (dbt_tas_iterator_blocks_left(iter))
276 : CALL dbt_tas_iterator_next_block(iter, row, column, block)
277 : CALL dbt_tas_put_block(matrix_b, row, column, block, summation=summation)
278 : END DO
279 : CALL dbt_tas_iterator_stop(iter)
280 : !$OMP END PARALLEL
281 :
282 230960 : CALL timestop(handle)
283 230960 : END SUBROUTINE
284 :
285 : ! **************************************************************************************************
286 : !> \brief Make sure that matrix_out has same blocks reserved as matrix_in.
287 : !> This assumes that both matrices have same number of block rows and block columns.
288 : !> \param matrix_in ...
289 : !> \param matrix_out ...
290 : !> \author Patrick Seewald
291 : ! **************************************************************************************************
292 370552 : SUBROUTINE dbt_tas_reserve_blocks_template(matrix_in, matrix_out)
293 : TYPE(dbt_tas_type), INTENT(IN) :: matrix_in
294 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix_out
295 :
296 : CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_tas_reserve_blocks_template'
297 :
298 : INTEGER :: handle, iblk, nblk
299 370552 : INTEGER(KIND=int_8), ALLOCATABLE, DIMENSION(:) :: columns, rows
300 : TYPE(dbt_tas_iterator) :: iter
301 :
302 370552 : CALL timeset(routineN, handle)
303 :
304 : !$OMP PARALLEL DEFAULT(NONE) SHARED(matrix_in,matrix_out) &
305 370552 : !$OMP PRIVATE(iter,nblk,rows,columns)
306 : CALL dbt_tas_iterator_start(iter, matrix_in)
307 : nblk = dbt_tas_iterator_num_blocks(iter)
308 : ALLOCATE (rows(nblk), columns(nblk))
309 : DO iblk = 1, nblk
310 : CALL dbt_tas_iterator_next_block(iter, row=rows(iblk), column=columns(iblk))
311 : END DO
312 : CPASSERT(.NOT. dbt_tas_iterator_blocks_left(iter))
313 : CALL dbt_tas_iterator_stop(iter)
314 :
315 : CALL dbt_tas_reserve_blocks_index(matrix_out, rows=rows, columns=columns)
316 : !$OMP END PARALLEL
317 :
318 370552 : CALL timestop(handle)
319 741104 : END SUBROUTINE
320 :
321 : ! **************************************************************************************************
322 : !> \brief ...
323 : !> \param matrix ...
324 : !> \author Patrick Seewald
325 : ! **************************************************************************************************
326 1839494 : SUBROUTINE dbt_tas_finalize(matrix)
327 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
328 :
329 1839494 : CALL dbm_finalize(matrix%matrix)
330 1839494 : END SUBROUTINE
331 :
332 : ! **************************************************************************************************
333 : !> \brief create new distribution.
334 : !> Exactly like dbm_distribution_new but with custom types for row_dist and col_dist
335 : !> instead of arrays.
336 : !> \param dist ...
337 : !> \param mp_comm ...
338 : !> \param row_dist ...
339 : !> \param col_dist ...
340 : !> \param split_info Strategy of how to split process grid (optional).
341 : !> If not present a default split heuristic is applied.
342 : !> \param nosplit if .TRUE. don't split process grid (optional)
343 : !> \author Patrick Seewald
344 : ! **************************************************************************************************
345 5917352 : SUBROUTINE dbt_tas_distribution_new(dist, mp_comm, row_dist, col_dist, split_info, nosplit)
346 : TYPE(dbt_tas_distribution_type), INTENT(OUT) :: dist
347 : TYPE(mp_cart_type), INTENT(IN) :: mp_comm
348 :
349 : CLASS(dbt_tas_distribution), INTENT(IN) :: row_dist, col_dist
350 : TYPE(dbt_tas_split_info), INTENT(IN), OPTIONAL :: split_info
351 : !!
352 : LOGICAL, INTENT(IN), OPTIONAL :: nosplit
353 : !LOGICAL, INTENT(IN), OPTIONAL :: strict_split
354 :
355 5072016 : TYPE(dbt_tas_split_info) :: split_info_prv
356 :
357 845336 : INTEGER, DIMENSION(:), POINTER, CONTIGUOUS :: row_dist_vec
358 845336 : INTEGER, DIMENSION(:), POINTER, CONTIGUOUS :: col_dist_vec
359 : INTEGER :: nrows, ncols, irow, col, icol, row, &
360 : split_rowcol, nsplit, handle
361 : LOGICAL :: opt_nsplit
362 : CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_tas_distribution_new'
363 :
364 845336 : CALL timeset(routineN, handle)
365 845336 : IF (PRESENT(split_info)) THEN
366 574744 : CALL dbt_tas_info_hold(split_info)
367 574744 : split_info_prv = split_info
368 : ELSE
369 : ! default split heuristic: split into submatrices that have roughly same block dimensions
370 270592 : IF (row_dist%nmrowcol >= col_dist%nmrowcol) THEN
371 254366 : split_rowcol = rowsplit
372 254366 : nsplit = INT((row_dist%nmrowcol - 1)/col_dist%nmrowcol + 1)
373 : ELSE
374 16226 : split_rowcol = colsplit
375 16226 : nsplit = INT((col_dist%nmrowcol - 1)/row_dist%nmrowcol + 1)
376 : END IF
377 270592 : opt_nsplit = .TRUE.
378 270592 : IF (PRESENT(nosplit)) THEN
379 198644 : IF (nosplit) THEN
380 198644 : nsplit = 1
381 198644 : opt_nsplit = .FALSE.
382 : END IF
383 : END IF
384 270592 : CALL dbt_tas_create_split(split_info_prv, mp_comm, split_rowcol, nsplit=nsplit, opt_nsplit=opt_nsplit)
385 : END IF
386 :
387 1495398 : SELECT CASE (split_info_prv%split_rowcol)
388 : CASE (rowsplit)
389 650062 : CALL group_to_mrowcol(split_info_prv, row_dist, split_info_prv%igroup, dist%local_rowcols)
390 650062 : nrows = SIZE(dist%local_rowcols)
391 650062 : ncols = INT(col_dist%nmrowcol)
392 1949607 : ALLOCATE (row_dist_vec(nrows))
393 1950186 : ALLOCATE (col_dist_vec(ncols))
394 5167371 : DO irow = 1, nrows
395 5167371 : row_dist_vec(irow) = row_dist%dist(dist%local_rowcols(irow)) - split_info_prv%pgrid_split_size*split_info_prv%igroup
396 : END DO
397 5019487 : DO col = 1, ncols
398 4369425 : col_dist_vec(col) = col_dist%dist(INT(col, KIND=int_8))
399 : END DO
400 : CASE (colsplit)
401 195274 : CALL group_to_mrowcol(split_info_prv, col_dist, split_info_prv%igroup, dist%local_rowcols)
402 195274 : ncols = SIZE(dist%local_rowcols)
403 195274 : nrows = INT(row_dist%nmrowcol)
404 584318 : ALLOCATE (col_dist_vec(ncols))
405 585822 : ALLOCATE (row_dist_vec(nrows))
406 8463972 : DO icol = 1, ncols
407 8463972 : col_dist_vec(icol) = col_dist%dist(dist%local_rowcols(icol)) - split_info_prv%pgrid_split_size*split_info_prv%igroup
408 : END DO
409 2585171 : DO row = 1, nrows
410 1544561 : row_dist_vec(row) = row_dist%dist(INT(row, KIND=int_8))
411 : END DO
412 : END SELECT
413 :
414 845336 : dist%info = split_info_prv
415 :
416 : CALL dbm_distribution_new(dist%dbm_dist, split_info_prv%mp_comm_group, &
417 845336 : row_dist_vec, col_dist_vec)
418 845336 : DEALLOCATE (row_dist_vec, col_dist_vec)
419 845336 : ALLOCATE (dist%row_dist, source=row_dist)
420 845336 : ALLOCATE (dist%col_dist, source=col_dist)
421 :
422 : !IF(PRESENT(strict_split)) dist%strict_split = strict_split
423 :
424 845336 : CALL timestop(handle)
425 1690672 : END SUBROUTINE
426 :
427 : ! **************************************************************************************************
428 : !> \brief ...
429 : !> \param dist ...
430 : !> \author Patrick Seewald
431 : ! **************************************************************************************************
432 1544636 : SUBROUTINE dbt_tas_distribution_destroy(dist)
433 : TYPE(dbt_tas_distribution_type), INTENT(INOUT) :: dist
434 :
435 : ! Note: Issue with Cray CCE compiler
436 : ! commented out the following deallocate statements on polymorphic variables,
437 : ! these cause segfaults with CCE compiler at a later point
438 :
439 : !IF (ALLOCATED(dist%row_dist)) THEN
440 : ! DEALLOCATE (dist%row_dist)
441 : !ENDIF
442 : !IF (ALLOCATED(dist%col_dist)) THEN
443 : ! DEALLOCATE (dist%col_dist)
444 : !ENDIF
445 :
446 1544636 : IF (ALLOCATED(dist%local_rowcols)) THEN
447 1544636 : DEALLOCATE (dist%local_rowcols)
448 : END IF
449 1544636 : CALL dbt_tas_release_info(dist%info)
450 1544636 : CALL dbm_distribution_release(dist%dbm_dist)
451 1544636 : END SUBROUTINE
452 :
453 : ! **************************************************************************************************
454 : !> \brief As dbt_get_stored_coordinates
455 : !> \param matrix ...
456 : !> \param row global matrix blocked row
457 : !> \param column global matrix blocked column
458 : !> \param processor process ID
459 : !> \author Patrick Seewald
460 : ! **************************************************************************************************
461 11090316 : SUBROUTINE dbt_tas_get_stored_coordinates(matrix, row, column, processor)
462 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
463 : INTEGER(KIND=int_8), INTENT(IN) :: row, column
464 : INTEGER, INTENT(OUT) :: processor
465 :
466 : INTEGER, DIMENSION(2) :: pcoord
467 : TYPE(dbt_tas_split_info), POINTER :: info
468 :
469 11090316 : pcoord(1) = matrix%dist%row_dist%dist(row)
470 11090316 : pcoord(2) = matrix%dist%col_dist%dist(column)
471 11090316 : info => dbt_tas_info(matrix)
472 :
473 : ! workaround for inefficient mpi_cart_rank
474 11090316 : processor = pcoord(1)*info%pdims(2) + pcoord(2)
475 :
476 11090316 : END SUBROUTINE
477 :
478 : ! **************************************************************************************************
479 : !> \brief Get all processors for a given row/col combination if matrix is replicated on each process
480 : !> subgroup.
481 : !> \param matrix tall-and-skinny matrix whose DBM submatrices are replicated matrices
482 : !> \param row row of a submatrix
483 : !> \param column column of a submatrix
484 : !> \param processors ...
485 : !> \author Patrick Seewald
486 : ! **************************************************************************************************
487 2873118 : SUBROUTINE dbt_repl_get_stored_coordinates(matrix, row, column, processors)
488 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
489 : INTEGER, INTENT(IN) :: row, column
490 : INTEGER, DIMENSION(:), INTENT(OUT) :: processors
491 :
492 : INTEGER :: igroup
493 : INTEGER(KIND=int_8) :: col_s, row_s
494 : INTEGER, DIMENSION(2) :: pcoord
495 17238708 : TYPE(dbt_tas_split_info) :: info
496 :
497 2873118 : row_s = INT(row, KIND=int_8); col_s = INT(column, KIND=int_8)
498 :
499 2873118 : info = dbt_tas_info(matrix)
500 2873118 : pcoord(1) = matrix%dist%row_dist%dist(row_s)
501 2873118 : pcoord(2) = matrix%dist%col_dist%dist(col_s)
502 :
503 7058156 : DO igroup = 0, info%ngroup - 1
504 4185038 : CALL info%mp_comm%rank_cart(pcoord, processors(igroup + 1))
505 2873118 : SELECT CASE (info%split_rowcol)
506 : CASE (rowsplit)
507 2720404 : row_s = row_s + dbt_tas_nblkrows_local(matrix)
508 2720404 : pcoord(1) = matrix%dist%row_dist%dist(row_s)
509 : CASE (colsplit)
510 1464634 : col_s = col_s + dbt_tas_nblkcols_local(matrix)
511 5649672 : pcoord(2) = matrix%dist%col_dist%dist(col_s)
512 : END SELECT
513 : END DO
514 2873118 : END SUBROUTINE
515 :
516 : ! **************************************************************************************************
517 : !> \brief Convert a tall-and-skinny matrix into a normal DBM matrix.
518 : !> This is not recommended for matrices with a very large dimension.
519 : !> \param matrix_rect ...
520 : !> \param matrix_dbm ...
521 : !> \author Patrick Seewald
522 : ! **************************************************************************************************
523 448 : SUBROUTINE dbt_tas_convert_to_dbm(matrix_rect, matrix_dbm)
524 : TYPE(dbt_tas_type), INTENT(IN) :: matrix_rect
525 : TYPE(dbm_type), INTENT(OUT) :: matrix_dbm
526 :
527 : CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_tas_convert_to_dbm'
528 :
529 : INTEGER :: handle, nblks_local, rb_count
530 : INTEGER(KIND=int_8) :: col, row
531 224 : INTEGER, ALLOCATABLE, DIMENSION(:) :: nz_cols, nz_rows
532 224 : INTEGER, CONTIGUOUS, DIMENSION(:), POINTER :: col_dist_vec, col_size_vec, &
533 224 : row_dist_vec, row_size_vec
534 224 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: block
535 : TYPE(dbm_distribution_obj) :: dist
536 : TYPE(dbt_tas_iterator) :: iter
537 1344 : TYPE(dbt_tas_split_info) :: info
538 :
539 224 : CALL timeset(routineN, handle)
540 :
541 224 : info = dbt_tas_info(matrix_rect)
542 :
543 672 : ALLOCATE (row_dist_vec(matrix_rect%nblkrows))
544 448 : ALLOCATE (row_size_vec(matrix_rect%nblkrows))
545 672 : ALLOCATE (col_dist_vec(matrix_rect%nblkcols))
546 448 : ALLOCATE (col_size_vec(matrix_rect%nblkcols))
547 :
548 8944 : DO row = 1, matrix_rect%nblkrows
549 8720 : row_dist_vec(row) = matrix_rect%dist%row_dist%dist(row)
550 8944 : row_size_vec(row) = matrix_rect%row_blk_size%data(row)
551 : END DO
552 :
553 7998 : DO col = 1, matrix_rect%nblkcols
554 7774 : col_dist_vec(col) = matrix_rect%dist%col_dist%dist(col)
555 7998 : col_size_vec(col) = matrix_rect%col_blk_size%data(col)
556 : END DO
557 :
558 224 : CALL dbm_distribution_new(dist, info%mp_comm, row_dist_vec, col_dist_vec)
559 224 : DEALLOCATE (row_dist_vec, col_dist_vec)
560 :
561 : CALL dbm_create(matrix=matrix_dbm, &
562 : name=TRIM(dbm_get_name(matrix_rect%matrix)), &
563 : dist=dist, &
564 : row_block_sizes=row_size_vec, &
565 224 : col_block_sizes=col_size_vec)
566 :
567 224 : CALL dbm_distribution_release(dist)
568 :
569 224 : DEALLOCATE (row_size_vec, col_size_vec)
570 :
571 : !$OMP PARALLEL DEFAULT(NONE) SHARED(matrix_rect,matrix_dbm) &
572 224 : !$OMP PRIVATE(iter,nblks_local,nz_rows,nz_cols,rb_count,row,col,block)
573 : CALL dbt_tas_iterator_start(iter, matrix_rect)
574 : nblks_local = dbt_tas_iterator_num_blocks(iter)
575 : ALLOCATE (nz_rows(nblks_local), nz_cols(nblks_local))
576 : rb_count = 0
577 : DO WHILE (dbt_tas_iterator_blocks_left(iter))
578 : CALL dbt_tas_iterator_next_block(iter, row, col)
579 : rb_count = rb_count + 1
580 : nz_rows(rb_count) = INT(row)
581 : nz_cols(rb_count) = INT(col)
582 : END DO
583 : CALL dbt_tas_iterator_stop(iter)
584 :
585 : CALL dbm_reserve_blocks(matrix_dbm, nz_rows, nz_cols)
586 :
587 : CALL dbt_tas_iterator_start(iter, matrix_rect)
588 : DO WHILE (dbt_tas_iterator_blocks_left(iter))
589 : CALL dbt_tas_iterator_next_block(iter, row, col, block)
590 : CALL dbm_put_block(matrix_dbm, INT(row), INT(col), block)
591 : END DO
592 : CALL dbt_tas_iterator_stop(iter)
593 : !$OMP END PARALLEL
594 :
595 224 : CALL dbm_finalize(matrix_dbm)
596 :
597 224 : CALL timestop(handle)
598 672 : END SUBROUTINE
599 :
600 : ! **************************************************************************************************
601 : !> \brief Converts a DBM matrix into the tall-and-skinny matrix type.
602 : !> \param info Strategy of how to split process grid
603 : !> \param matrix_rect ...
604 : !> \param matrix_dbm ...
605 : !> \author Patrick Seewald
606 : ! **************************************************************************************************
607 0 : SUBROUTINE dbt_tas_convert_to_tas(info, matrix_rect, matrix_dbm)
608 : TYPE(dbt_tas_split_info), INTENT(IN) :: info
609 : TYPE(dbt_tas_type), INTENT(OUT) :: matrix_rect
610 : TYPE(dbm_type), INTENT(IN) :: matrix_dbm
611 :
612 : CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_tas_convert_to_tas'
613 :
614 : CHARACTER(len=default_string_length) :: name
615 : INTEGER :: col, handle, row
616 : INTEGER(KIND=int_8) :: nbcols, nbrows
617 0 : INTEGER, CONTIGUOUS, DIMENSION(:), POINTER :: col_blk_size, row_blk_size
618 : INTEGER, DIMENSION(2) :: pdims
619 0 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: block
620 : TYPE(dbm_distribution_obj) :: dbm_dist
621 : TYPE(dbm_iterator) :: iter
622 0 : TYPE(dbt_tas_blk_size_arb) :: col_blk_size_obj, row_blk_size_obj
623 0 : TYPE(dbt_tas_dist_arb) :: col_dist_obj, row_dist_obj
624 0 : TYPE(dbt_tas_distribution_type) :: dist
625 :
626 : NULLIFY (col_blk_size, row_blk_size)
627 0 : CALL timeset(routineN, handle)
628 0 : pdims = info%mp_comm%num_pe_cart
629 :
630 0 : name = dbm_get_name(matrix_dbm)
631 0 : row_blk_size => dbm_get_row_block_sizes(matrix_dbm)
632 0 : col_blk_size => dbm_get_col_block_sizes(matrix_dbm)
633 :
634 0 : nbrows = SIZE(row_blk_size)
635 0 : nbcols = SIZE(col_blk_size)
636 :
637 0 : dbm_dist = dbm_get_distribution(matrix_dbm)
638 0 : row_dist_obj = dbt_tas_dist_arb(dbm_distribution_row_dist(dbm_dist), pdims(1), nbrows)
639 0 : col_dist_obj = dbt_tas_dist_arb(dbm_distribution_col_dist(dbm_dist), pdims(2), nbcols)
640 :
641 0 : row_blk_size_obj = dbt_tas_blk_size_arb(row_blk_size)
642 0 : col_blk_size_obj = dbt_tas_blk_size_arb(col_blk_size)
643 :
644 0 : CALL dbt_tas_distribution_new(dist, info%mp_comm, row_dist_obj, col_dist_obj)
645 :
646 : CALL dbt_tas_create(matrix_rect, TRIM(name)//"_compressed", &
647 0 : dist, row_blk_size_obj, col_blk_size_obj)
648 :
649 0 : !$OMP PARALLEL DEFAULT(NONE) SHARED(matrix_dbm,matrix_rect) PRIVATE(iter,row,col,block)
650 : CALL dbm_iterator_start(iter, matrix_dbm)
651 : DO WHILE (dbm_iterator_blocks_left(iter))
652 : CALL dbm_iterator_next_block(iter, row, col, block)
653 : CALL dbt_tas_put_block(matrix_rect, INT(row, KIND=int_8), INT(col, KIND=int_8), block)
654 : END DO
655 : CALL dbm_iterator_stop(iter)
656 : !$OMP END PARALLEL
657 :
658 0 : CALL dbt_tas_finalize(matrix_rect)
659 :
660 0 : CALL timestop(handle)
661 0 : END SUBROUTINE
662 :
663 : ! **************************************************************************************************
664 : !> \brief As dbm_iterator_start
665 : !> \param iter ...
666 : !> \param matrix_in ...
667 : !> \author Patrick Seewald
668 : ! **************************************************************************************************
669 2924232 : SUBROUTINE dbt_tas_iterator_start(iter, matrix_in)
670 : TYPE(dbt_tas_iterator), INTENT(INOUT) :: iter
671 : TYPE(dbt_tas_type), INTENT(IN), TARGET :: matrix_in
672 :
673 2924232 : CALL dbm_iterator_start(iter%iter, matrix_in%matrix)
674 :
675 2924232 : iter%dist => matrix_in%dist
676 2924232 : END SUBROUTINE
677 :
678 : ! **************************************************************************************************
679 : !> \brief As dbm_iterator_num_blocks
680 : !> \param iter ...
681 : !> \return ...
682 : !> \author Ole Schuett
683 : ! **************************************************************************************************
684 620127 : FUNCTION dbt_tas_iterator_num_blocks(iter)
685 : TYPE(dbt_tas_iterator), INTENT(IN) :: iter
686 : INTEGER :: dbt_tas_iterator_num_blocks
687 :
688 620127 : dbt_tas_iterator_num_blocks = dbm_iterator_num_blocks(iter%iter)
689 620127 : END FUNCTION
690 :
691 : ! **************************************************************************************************
692 : !> \brief As dbm_iterator_blocks_left
693 : !> \param iter ...
694 : !> \return ...
695 : !> \author Patrick Seewald
696 : ! **************************************************************************************************
697 53338076 : FUNCTION dbt_tas_iterator_blocks_left(iter)
698 : TYPE(dbt_tas_iterator), INTENT(IN) :: iter
699 : LOGICAL :: dbt_tas_iterator_blocks_left
700 :
701 53338076 : dbt_tas_iterator_blocks_left = dbm_iterator_blocks_left(iter%iter)
702 53338076 : END FUNCTION
703 :
704 : ! **************************************************************************************************
705 : !> \brief As dbm_iterator_stop
706 : !> \param iter ...
707 : !> \author Patrick Seewald
708 : ! **************************************************************************************************
709 2924232 : SUBROUTINE dbt_tas_iterator_stop(iter)
710 : TYPE(dbt_tas_iterator), INTENT(INOUT) :: iter
711 :
712 2924232 : CALL dbm_iterator_stop(iter%iter)
713 2924232 : END SUBROUTINE
714 :
715 : ! **************************************************************************************************
716 : !> \brief As dbm_iterator_next_block
717 : !> \param iterator ...
718 : !> \param row global block row
719 : !> \param column global block column
720 : !> \param row_size ...
721 : !> \param col_size ...
722 : !> \author Patrick Seewald
723 : ! **************************************************************************************************
724 97233688 : SUBROUTINE dbt_tas_iterator_next_block_index(iterator, row, column, row_size, col_size)
725 : TYPE(dbt_tas_iterator), INTENT(INOUT) :: iterator
726 : INTEGER(KIND=int_8), INTENT(OUT) :: row, column
727 : INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size
728 :
729 : INTEGER :: column_group, row_group
730 :
731 : CALL dbm_iterator_next_block(iterator%iter, row=row_group, column=column_group, &
732 48616844 : row_size=row_size, col_size=col_size)
733 :
734 : CALL dbt_index_local_to_global(iterator%dist%info, iterator%dist, row_group=row_group, column_group=column_group, &
735 48616844 : row=row, column=column)
736 :
737 48616844 : END SUBROUTINE
738 :
739 : ! **************************************************************************************************
740 : !> \brief As dbm_reserve_blocks
741 : !> \param matrix ...
742 : !> \param rows ...
743 : !> \param columns ...
744 : !> \author Patrick Seewald
745 : ! **************************************************************************************************
746 1238335 : SUBROUTINE dbt_tas_reserve_blocks_index(matrix, rows, columns)
747 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
748 : INTEGER(KIND=int_8), DIMENSION(:), INTENT(IN) :: rows, columns
749 :
750 : CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_tas_reserve_blocks_index'
751 :
752 : INTEGER :: handle, i
753 2476670 : INTEGER, DIMENSION(SIZE(rows)) :: columns_group, rows_group
754 : TYPE(dbt_tas_split_info), POINTER :: info
755 :
756 1238335 : CALL timeset(routineN, handle)
757 :
758 1238335 : info => dbt_tas_info(matrix)
759 :
760 1238335 : CPASSERT(SIZE(rows) == SIZE(columns))
761 26482197 : DO i = 1, SIZE(rows)
762 : CALL dbt_index_global_to_local(info, matrix%dist, &
763 : row=rows(i), row_group=rows_group(i), &
764 26482197 : column=columns(i), column_group=columns_group(i))
765 : END DO
766 :
767 1238335 : CALL dbm_reserve_blocks(matrix%matrix, rows_group, columns_group)
768 :
769 1238335 : CALL timestop(handle)
770 1238335 : END SUBROUTINE
771 :
772 : ! **************************************************************************************************
773 : !> \brief Copy a distribution
774 : !> \param dist_in ...
775 : !> \param dist_out ...
776 : !> \param own_dist Whether distribution should be owned by dist_out
777 : !> \author Patrick Seewald
778 : ! **************************************************************************************************
779 7826728 : SUBROUTINE dbt_tas_copy_distribution(dist_in, dist_out, own_dist)
780 : TYPE(dbt_tas_distribution_type), INTENT(INOUT) :: dist_in
781 : TYPE(dbt_tas_distribution_type), INTENT(OUT) :: dist_out
782 : LOGICAL, INTENT(IN), OPTIONAL :: own_dist
783 :
784 : LOGICAL :: own_dist_prv
785 :
786 1118104 : IF (PRESENT(own_dist)) THEN
787 418804 : own_dist_prv = own_dist
788 : ELSE
789 : own_dist_prv = .FALSE.
790 : END IF
791 :
792 418804 : IF (.NOT. own_dist_prv) THEN
793 699300 : CALL dbm_distribution_hold(dist_in%dbm_dist)
794 699300 : CALL dbt_tas_info_hold(dist_in%info)
795 : END IF
796 :
797 1118104 : dist_out = dist_in
798 1118104 : END SUBROUTINE
799 :
800 : ! **************************************************************************************************
801 : !> \brief Get block size for a given row & column
802 : !> \param matrix ...
803 : !> \param row ...
804 : !> \param col ...
805 : !> \param row_size ...
806 : !> \param col_size ...
807 : !> \author Patrick Seewald
808 : ! **************************************************************************************************
809 4350516 : SUBROUTINE dbt_tas_blk_sizes(matrix, row, col, row_size, col_size)
810 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
811 : INTEGER(KIND=int_8), INTENT(IN) :: row, col
812 : INTEGER, INTENT(OUT) :: row_size, col_size
813 :
814 4350516 : row_size = matrix%row_blk_size%data(row)
815 4350516 : col_size = matrix%col_blk_size%data(col)
816 4350516 : END SUBROUTINE
817 :
818 : ! **************************************************************************************************
819 : !> \brief get info on mpi grid splitting
820 : !> \param matrix ...
821 : !> \return ...
822 : !> \author Patrick Seewald
823 : ! **************************************************************************************************
824 254012638 : FUNCTION dbt_tas_info(matrix)
825 : TYPE(dbt_tas_type), INTENT(IN), TARGET :: matrix
826 : TYPE(dbt_tas_split_info), POINTER :: dbt_tas_info
827 :
828 254012638 : dbt_tas_info => matrix%dist%info
829 254012638 : END FUNCTION
830 :
831 : ! **************************************************************************************************
832 : !> \brief ...
833 : !> \param matrix ...
834 : !> \return ...
835 : !> \author Patrick Seewald
836 : ! **************************************************************************************************
837 1557884 : PURE FUNCTION dbt_tas_nblkrows_total(matrix) RESULT(nblkrows_total)
838 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
839 : INTEGER(KIND=int_8) :: nblkrows_total
840 :
841 1557884 : nblkrows_total = matrix%nblkrows
842 1557884 : END FUNCTION
843 :
844 : ! **************************************************************************************************
845 : !> \brief ...
846 : !> \param matrix ...
847 : !> \return ...
848 : !> \author Patrick Seewald
849 : ! **************************************************************************************************
850 0 : PURE FUNCTION dbt_tas_nfullrows_total(matrix) RESULT(nfullrows_total)
851 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
852 : INTEGER(KIND=int_8) :: nfullrows_total
853 :
854 0 : nfullrows_total = matrix%nfullrows
855 0 : END FUNCTION
856 :
857 : ! **************************************************************************************************
858 : !> \brief ...
859 : !> \param matrix ...
860 : !> \return ...
861 : !> \author Patrick Seewald
862 : ! **************************************************************************************************
863 1558392 : PURE FUNCTION dbt_tas_nblkcols_total(matrix) RESULT(nblkcols_total)
864 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
865 : INTEGER(KIND=int_8) :: nblkcols_total
866 :
867 1558392 : nblkcols_total = matrix%nblkcols
868 1558392 : END FUNCTION
869 :
870 : ! **************************************************************************************************
871 : !> \brief ...
872 : !> \param matrix ...
873 : !> \return ...
874 : !> \author Patrick Seewald
875 : ! **************************************************************************************************
876 0 : PURE FUNCTION dbt_tas_nfullcols_total(matrix) RESULT(nfullcols_total)
877 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
878 : INTEGER(KIND=int_8) :: nfullcols_total
879 :
880 0 : nfullcols_total = matrix%nfullcols
881 0 : END FUNCTION
882 :
883 : ! **************************************************************************************************
884 : !> \brief ...
885 : !> \param matrix ...
886 : !> \return ...
887 : !> \author Patrick Seewald
888 : ! **************************************************************************************************
889 1464634 : FUNCTION dbt_tas_nblkcols_local(matrix) RESULT(nblkcols_local)
890 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
891 : INTEGER :: nblkcols_local
892 :
893 1464634 : nblkcols_local = SIZE(dbm_get_col_block_sizes(matrix%matrix))
894 1464634 : END FUNCTION
895 :
896 : ! **************************************************************************************************
897 : !> \brief ...
898 : !> \param matrix ...
899 : !> \return ...
900 : !> \author Patrick Seewald
901 : ! **************************************************************************************************
902 2720404 : FUNCTION dbt_tas_nblkrows_local(matrix) RESULT(nblkrows_local)
903 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
904 : INTEGER :: nblkrows_local
905 :
906 2720404 : nblkrows_local = SIZE(dbm_get_row_block_sizes(matrix%matrix))
907 2720404 : END FUNCTION
908 :
909 : ! **************************************************************************************************
910 : !> \brief As dbt_get_num_blocks: get number of local blocks
911 : !> \param matrix ...
912 : !> \return ...
913 : !> \author Patrick Seewald
914 : ! **************************************************************************************************
915 992542 : PURE FUNCTION dbt_tas_get_num_blocks(matrix) RESULT(num_blocks)
916 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
917 : INTEGER :: num_blocks
918 :
919 992542 : num_blocks = dbm_get_num_blocks(matrix%matrix)
920 992542 : END FUNCTION
921 :
922 : ! **************************************************************************************************
923 : !> \brief get total number of blocks
924 : !> \param matrix ...
925 : !> \return ...
926 : !> \author Patrick Seewald
927 : ! **************************************************************************************************
928 273776 : FUNCTION dbt_tas_get_num_blocks_total(matrix) RESULT(num_blocks)
929 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
930 : INTEGER(KIND=int_8) :: num_blocks
931 :
932 1368880 : TYPE(dbt_tas_split_info) :: info
933 :
934 273776 : info = dbt_tas_info(matrix)
935 273776 : num_blocks = dbt_tas_get_num_blocks(matrix)
936 273776 : CALL info%mp_comm%sum(num_blocks)
937 :
938 273776 : END FUNCTION
939 :
940 : ! **************************************************************************************************
941 : !> \brief As dbt_get_nze: get number of local non-zero elements
942 : !> \param matrix ...
943 : !> \return ...
944 : !> \author Patrick Seewald
945 : ! **************************************************************************************************
946 1606114 : PURE FUNCTION dbt_tas_get_nze(matrix)
947 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
948 : INTEGER :: dbt_tas_get_nze
949 :
950 1606114 : dbt_tas_get_nze = dbm_get_nze(matrix%matrix)
951 :
952 1606114 : END FUNCTION
953 :
954 : ! **************************************************************************************************
955 : !> \brief Get total number of non-zero elements
956 : !> \param matrix ...
957 : !> \return ...
958 : !> \author Patrick Seewald
959 : ! **************************************************************************************************
960 1334360 : FUNCTION dbt_tas_get_nze_total(matrix)
961 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
962 : INTEGER(KIND=int_8) :: dbt_tas_get_nze_total
963 :
964 6671800 : TYPE(dbt_tas_split_info) :: info
965 :
966 1334360 : dbt_tas_get_nze_total = dbt_tas_get_nze(matrix)
967 1334360 : info = dbt_tas_info(matrix)
968 1334360 : CALL info%mp_comm%sum(dbt_tas_get_nze_total)
969 1334360 : END FUNCTION
970 :
971 : ! **************************************************************************************************
972 : !> \brief Clear matrix (erase all data)
973 : !> \param matrix ...
974 : !> \author Patrick Seewald
975 : ! **************************************************************************************************
976 1793983 : SUBROUTINE dbt_tas_clear(matrix)
977 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
978 :
979 1793983 : CALL dbm_clear(matrix%matrix)
980 1793983 : END SUBROUTINE
981 :
982 : ! **************************************************************************************************
983 : !> \brief ...
984 : !> \param matrix ...
985 : !> \param nblkrows_total ...
986 : !> \param nblkcols_total ...
987 : !> \param local_rows ...
988 : !> \param local_cols ...
989 : !> \param proc_row_dist ...
990 : !> \param proc_col_dist ...
991 : !> \param row_blk_size ...
992 : !> \param col_blk_size ...
993 : !> \param distribution ...
994 : !> \param name ...
995 : !> \author Patrick Seewald
996 : ! **************************************************************************************************
997 1341484 : SUBROUTINE dbt_tas_get_info(matrix, &
998 : nblkrows_total, nblkcols_total, &
999 : local_rows, local_cols, &
1000 : proc_row_dist, proc_col_dist, &
1001 : row_blk_size, col_blk_size, distribution, name)
1002 :
1003 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
1004 : INTEGER(KIND=int_8), INTENT(OUT), OPTIONAL :: nblkrows_total, nblkcols_total
1005 : INTEGER(KIND=int_8), ALLOCATABLE, DIMENSION(:), &
1006 : OPTIONAL :: local_rows, local_cols
1007 :
1008 : CLASS(dbt_tas_distribution), ALLOCATABLE, OPTIONAL, &
1009 : INTENT(OUT) :: proc_row_dist, proc_col_dist
1010 : CLASS(dbt_tas_rowcol_data), ALLOCATABLE, OPTIONAL, &
1011 : INTENT(OUT) :: row_blk_size, col_blk_size
1012 : TYPE(dbt_tas_distribution_type), OPTIONAL :: distribution
1013 : CHARACTER(len=*), INTENT(OUT), OPTIONAL :: name
1014 :
1015 6707420 : TYPE(dbt_tas_split_info) :: info
1016 : INTEGER :: irow, icol
1017 1341484 : INTEGER, ALLOCATABLE, DIMENSION(:) :: local_rows_local, local_cols_local
1018 :
1019 1341484 : info = dbt_tas_info(matrix)
1020 :
1021 1341484 : IF (PRESENT(local_rows)) THEN
1022 300592 : CALL dbm_get_local_rows(matrix%matrix, local_rows_local)
1023 901752 : ALLOCATE (local_rows(SIZE(local_rows_local)))
1024 3835476 : DO irow = 1, SIZE(local_rows_local)
1025 3835476 : CALL dbt_index_local_to_global(info, matrix%dist, row_group=local_rows_local(irow), row=local_rows(irow))
1026 : END DO
1027 : END IF
1028 :
1029 1341484 : IF (PRESENT(local_cols)) THEN
1030 109898 : CALL dbm_get_local_cols(matrix%matrix, local_cols_local)
1031 326570 : ALLOCATE (local_cols(SIZE(local_cols_local)))
1032 37447866 : DO icol = 1, SIZE(local_cols_local)
1033 37447866 : CALL dbt_index_local_to_global(info, matrix%dist, column_group=local_cols_local(icol), column=local_cols(icol))
1034 : END DO
1035 : END IF
1036 :
1037 1341484 : IF (PRESENT(name)) name = dbm_get_name(matrix%matrix)
1038 1341484 : IF (PRESENT(nblkrows_total)) nblkrows_total = dbt_tas_nblkrows_total(matrix)
1039 1341484 : IF (PRESENT(nblkcols_total)) nblkcols_total = dbt_tas_nblkcols_total(matrix)
1040 1341484 : IF (PRESENT(proc_row_dist)) ALLOCATE (proc_row_dist, SOURCE=matrix%dist%row_dist)
1041 1341484 : IF (PRESENT(proc_col_dist)) ALLOCATE (proc_col_dist, SOURCE=matrix%dist%col_dist)
1042 1341484 : IF (PRESENT(row_blk_size)) ALLOCATE (row_blk_size, SOURCE=matrix%row_blk_size)
1043 1341484 : IF (PRESENT(col_blk_size)) ALLOCATE (col_blk_size, SOURCE=matrix%col_blk_size)
1044 1341484 : IF (PRESENT(distribution)) distribution = matrix%dist
1045 :
1046 2682968 : END SUBROUTINE
1047 :
1048 : ! **************************************************************************************************
1049 : !> \brief As dbm_iterator_next_block
1050 : !> \param iterator ...
1051 : !> \param row ...
1052 : !> \param column ...
1053 : !> \param block ...
1054 : !> \param row_size ...
1055 : !> \param col_size ...
1056 : !> \author Patrick Seewald
1057 : ! **************************************************************************************************
1058 26926118 : SUBROUTINE dbt_tas_iterator_next_block_d(iterator, row, column, block, row_size, col_size)
1059 : TYPE(dbt_tas_iterator), INTENT(INOUT) :: iterator
1060 : INTEGER(KIND=int_8), INTENT(OUT) :: row, column
1061 : REAL(dp), DIMENSION(:, :), POINTER :: block
1062 : INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size
1063 :
1064 : INTEGER :: column_group, row_group
1065 :
1066 : CALL dbm_iterator_next_block(iterator%iter, row_group, column_group, block, &
1067 13463059 : row_size=row_size, col_size=col_size)
1068 :
1069 : CALL dbt_index_local_to_global(iterator%dist%info, iterator%dist, row_group=row_group, column_group=column_group, &
1070 13463059 : row=row, column=column)
1071 :
1072 13463059 : END SUBROUTINE
1073 :
1074 : ! **************************************************************************************************
1075 : !> \brief As dbm_put_block
1076 : !> \param matrix ...
1077 : !> \param row ...
1078 : !> \param col ...
1079 : !> \param block ...
1080 : !> \param summation ...
1081 : !> \author Patrick Seewald
1082 : ! **************************************************************************************************
1083 32180802 : SUBROUTINE dbt_tas_put_block(matrix, row, col, block, summation)
1084 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
1085 : INTEGER(KIND=int_8), INTENT(IN) :: row, col
1086 : REAL(dp), DIMENSION(:, :), INTENT(IN) :: block
1087 : LOGICAL, INTENT(IN), OPTIONAL :: summation
1088 :
1089 : INTEGER :: col_group, row_group
1090 :
1091 : CALL dbt_index_global_to_local(matrix%dist%info, matrix%dist, row=row, column=col, &
1092 32180802 : row_group=row_group, column_group=col_group)
1093 :
1094 16507935725 : CALL dbm_put_block(matrix%matrix, row_group, col_group, block, summation=summation)
1095 :
1096 32180802 : END SUBROUTINE
1097 :
1098 : ! **************************************************************************************************
1099 : !> \brief As dbm_get_block_p
1100 : !> \param matrix ...
1101 : !> \param row ...
1102 : !> \param col ...
1103 : !> \param block ...
1104 : !> \param row_size ...
1105 : !> \param col_size ...
1106 : !> \author Patrick Seewald
1107 : ! **************************************************************************************************
1108 45059486 : SUBROUTINE dbt_tas_get_block_p(matrix, row, col, block, row_size, col_size)
1109 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
1110 : INTEGER(KIND=int_8), INTENT(IN) :: row, col
1111 : REAL(dp), DIMENSION(:, :), POINTER :: block
1112 : INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size
1113 :
1114 : INTEGER :: col_group, row_group
1115 :
1116 : CALL dbt_index_global_to_local(matrix%dist%info, matrix%dist, row=row, column=col, &
1117 22529743 : row_group=row_group, column_group=col_group)
1118 :
1119 : CALL dbm_get_block_p(matrix%matrix, row_group, col_group, block, &
1120 22529743 : row_size=row_size, col_size=col_size)
1121 :
1122 22529743 : END SUBROUTINE
1123 :
1124 : ! **************************************************************************************************
1125 : !> \brief As dbm_filter
1126 : !> \param matrix ...
1127 : !> \param eps ...
1128 : !> \author Patrick Seewald
1129 : ! **************************************************************************************************
1130 378536 : SUBROUTINE dbt_tas_filter(matrix, eps)
1131 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
1132 : REAL(dp), INTENT(IN) :: eps
1133 :
1134 378536 : CALL dbm_filter(matrix%matrix, eps)
1135 :
1136 378536 : END SUBROUTINE
1137 :
1138 5822962 : END MODULE
|
