(git:e7e05ae)
dbt_tas_base.F
Go to the documentation of this file.
1 !--------------------------------------------------------------------------------------------------!
2 ! CP2K: A general program to perform molecular dynamics simulations !
3 ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 ! !
5 ! SPDX-License-Identifier: GPL-2.0-or-later !
6 !--------------------------------------------------------------------------------------------------!
7 
8 ! **************************************************************************************************
9 !> \brief 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  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) :: info
127 
128  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  CALL timeset(routinen, handle)
134 
135  CALL dbt_tas_copy_distribution(dist, matrix%dist, own_dist)
136  matrix%nblkrows = row_blk_size%nmrowcol
137  matrix%nblkcols = col_blk_size%nmrowcol
138 
139  cpassert(matrix%nblkrows == dist%row_dist%nmrowcol)
140  cpassert(matrix%nblkcols == dist%col_dist%nmrowcol)
141 
142  matrix%nfullrows = row_blk_size%nfullrowcol
143  matrix%nfullcols = col_blk_size%nfullrowcol
144 
145  ALLOCATE (matrix%row_blk_size, source=row_blk_size)
146  ALLOCATE (matrix%col_blk_size, source=col_blk_size)
147 
148  info = dbt_tas_info(matrix)
149 
150  SELECT CASE (info%split_rowcol)
151  CASE (rowsplit)
152  matrix%nblkrowscols_split = matrix%nblkrows
153 
154  associate(rows => dist%local_rowcols)
155  nrows = SIZE(rows)
156  ncols = int(dist%col_dist%nmrowcol)
157  ALLOCATE (row_blk_size_vec(nrows))
158  ALLOCATE (col_blk_size_vec(ncols))
159  DO irow = 1, nrows
160  row_blk_size_vec(irow) = row_blk_size%data(rows(irow))
161  END DO
162  DO col = 1, ncols
163  col_blk_size_vec(col) = col_blk_size%data(int(col, kind=int_8))
164  END DO
165  END associate
166  CASE (colsplit)
167  matrix%nblkrowscols_split = matrix%nblkcols
168 
169  associate(cols => dist%local_rowcols)
170  ncols = SIZE(cols)
171  nrows = int(dist%row_dist%nmrowcol)
172  ALLOCATE (row_blk_size_vec(nrows))
173  ALLOCATE (col_blk_size_vec(ncols))
174  DO icol = 1, ncols
175  col_blk_size_vec(icol) = col_blk_size%data(cols(icol))
176  END DO
177  DO row = 1, nrows
178  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  col_block_sizes=col_blk_size_vec)
188 
189  DEALLOCATE (row_blk_size_vec, col_blk_size_vec)
190  matrix%valid = .true.
191  CALL timestop(handle)
192 
193  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  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  IF (PRESENT(name)) THEN
208  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  template=matrix_in%matrix)
212  END IF
213  CALL dbm_finalize(matrix%matrix)
214 
215  CALL dbt_tas_copy_distribution(matrix_in%dist, matrix%dist)
216  ALLOCATE (matrix%row_blk_size, source=matrix_in%row_blk_size)
217  ALLOCATE (matrix%col_blk_size, source=matrix_in%col_blk_size)
218  matrix%nblkrows = matrix_in%nblkrows
219  matrix%nblkcols = matrix_in%nblkcols
220  matrix%nblkrowscols_split = matrix_in%nblkrowscols_split
221  matrix%nfullrows = matrix_in%nfullrows
222  matrix%nfullcols = matrix_in%nfullcols
223  matrix%valid = .true.
224 
225  END SUBROUTINE
226 
227 ! **************************************************************************************************
228 !> \brief ...
229 !> \param matrix ...
230 !> \author Patrick Seewald
231 ! **************************************************************************************************
232  SUBROUTINE dbt_tas_destroy(matrix)
233  TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
234 
235  CALL dbm_release(matrix%matrix)
236  CALL dbt_tas_distribution_destroy(matrix%dist)
237  DEALLOCATE (matrix%row_blk_size)
238  DEALLOCATE (matrix%col_blk_size)
239  matrix%valid = .false.
240  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  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  REAL(kind=dp), DIMENSION(:, :), POINTER :: block
259  TYPE(dbt_tas_iterator) :: iter
260 
261  CALL timeset(routinen, handle)
262  cpassert(matrix_b%valid)
263 
264  IF (PRESENT(summation)) THEN
265  IF (.NOT. summation) CALL dbt_tas_clear(matrix_b)
266  ELSE
267  CALL dbt_tas_clear(matrix_b)
268  END IF
269 
270  CALL dbt_tas_reserve_blocks(matrix_a, matrix_b)
271 
272 !$OMP PARALLEL DEFAULT(NONE) SHARED(matrix_a,matrix_b,summation) &
273 !$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  CALL timestop(handle)
283  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  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  INTEGER(KIND=int_8), ALLOCATABLE, DIMENSION(:) :: columns, rows
300  TYPE(dbt_tas_iterator) :: iter
301 
302  CALL timeset(routinen, handle)
303 
304 !$OMP PARALLEL DEFAULT(NONE) SHARED(matrix_in,matrix_out) &
305 !$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  CALL timestop(handle)
319  END SUBROUTINE
320 
321 ! **************************************************************************************************
322 !> \brief ...
323 !> \param matrix ...
324 !> \author Patrick Seewald
325 ! **************************************************************************************************
326  SUBROUTINE dbt_tas_finalize(matrix)
327  TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
328 
329  CALL dbm_finalize(matrix%matrix)
330  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  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  TYPE(dbt_tas_split_info) :: split_info_prv
356 
357  INTEGER, DIMENSION(:), POINTER, CONTIGUOUS :: row_dist_vec
358  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  CALL timeset(routinen, handle)
365  IF (PRESENT(split_info)) THEN
366  CALL dbt_tas_info_hold(split_info)
367  split_info_prv = split_info
368  ELSE
369  ! default split heuristic: split into submatrices that have roughly same block dimensions
370  IF (row_dist%nmrowcol >= col_dist%nmrowcol) THEN
371  split_rowcol = rowsplit
372  nsplit = int((row_dist%nmrowcol - 1)/col_dist%nmrowcol + 1)
373  ELSE
374  split_rowcol = colsplit
375  nsplit = int((col_dist%nmrowcol - 1)/row_dist%nmrowcol + 1)
376  END IF
377  opt_nsplit = .true.
378  IF (PRESENT(nosplit)) THEN
379  IF (nosplit) THEN
380  nsplit = 1
381  opt_nsplit = .false.
382  END IF
383  END IF
384  CALL dbt_tas_create_split(split_info_prv, mp_comm, split_rowcol, nsplit=nsplit, opt_nsplit=opt_nsplit)
385  END IF
386 
387  SELECT CASE (split_info_prv%split_rowcol)
388  CASE (rowsplit)
389  CALL group_to_mrowcol(split_info_prv, row_dist, split_info_prv%igroup, dist%local_rowcols)
390  nrows = SIZE(dist%local_rowcols)
391  ncols = int(col_dist%nmrowcol)
392  ALLOCATE (row_dist_vec(nrows))
393  ALLOCATE (col_dist_vec(ncols))
394  DO irow = 1, nrows
395  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  DO col = 1, ncols
398  col_dist_vec(col) = col_dist%dist(int(col, kind=int_8))
399  END DO
400  CASE (colsplit)
401  CALL group_to_mrowcol(split_info_prv, col_dist, split_info_prv%igroup, dist%local_rowcols)
402  ncols = SIZE(dist%local_rowcols)
403  nrows = int(row_dist%nmrowcol)
404  ALLOCATE (col_dist_vec(ncols))
405  ALLOCATE (row_dist_vec(nrows))
406  DO icol = 1, ncols
407  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  DO row = 1, nrows
410  row_dist_vec(row) = row_dist%dist(int(row, kind=int_8))
411  END DO
412  END SELECT
413 
414  dist%info = split_info_prv
415 
416  CALL dbm_distribution_new(dist%dbm_dist, split_info_prv%mp_comm_group, &
417  row_dist_vec, col_dist_vec)
418  DEALLOCATE (row_dist_vec, col_dist_vec)
419  ALLOCATE (dist%row_dist, source=row_dist)
420  ALLOCATE (dist%col_dist, source=col_dist)
421 
422  !IF(PRESENT(strict_split)) dist%strict_split = strict_split
423 
424  CALL timestop(handle)
425  END SUBROUTINE
426 
427 ! **************************************************************************************************
428 !> \brief ...
429 !> \param dist ...
430 !> \author Patrick Seewald
431 ! **************************************************************************************************
432  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  IF (ALLOCATED(dist%local_rowcols)) THEN
447  DEALLOCATE (dist%local_rowcols)
448  END IF
449  CALL dbt_tas_release_info(dist%info)
450  CALL dbm_distribution_release(dist%dbm_dist)
451  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  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) :: info
468 
469  pcoord(1) = matrix%dist%row_dist%dist(row)
470  pcoord(2) = matrix%dist%col_dist%dist(column)
471  info = dbt_tas_info(matrix)
472 
473  ! workaround for inefficient mpi_cart_rank
474  processor = pcoord(1)*info%pdims(2) + pcoord(2)
475 
476  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  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  TYPE(dbt_tas_split_info) :: info
496 
497  row_s = int(row, kind=int_8); col_s = int(column, kind=int_8)
498 
499  info = dbt_tas_info(matrix)
500  pcoord(1) = matrix%dist%row_dist%dist(row_s)
501  pcoord(2) = matrix%dist%col_dist%dist(col_s)
502 
503  DO igroup = 0, info%ngroup - 1
504  CALL info%mp_comm%rank_cart(pcoord, processors(igroup + 1))
505  SELECT CASE (info%split_rowcol)
506  CASE (rowsplit)
507  row_s = row_s + dbt_tas_nblkrows_local(matrix)
508  pcoord(1) = matrix%dist%row_dist%dist(row_s)
509  CASE (colsplit)
510  col_s = col_s + dbt_tas_nblkcols_local(matrix)
511  pcoord(2) = matrix%dist%col_dist%dist(col_s)
512  END SELECT
513  END DO
514  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  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  INTEGER, ALLOCATABLE, DIMENSION(:) :: nz_cols, nz_rows
532  INTEGER, CONTIGUOUS, DIMENSION(:), POINTER :: col_dist_vec, col_size_vec, &
533  row_dist_vec, row_size_vec
534  REAL(kind=dp), DIMENSION(:, :), POINTER :: block
535  TYPE(dbm_distribution_obj) :: dist
536  TYPE(dbt_tas_iterator) :: iter
537  TYPE(dbt_tas_split_info) :: info
538 
539  CALL timeset(routinen, handle)
540 
541  info = dbt_tas_info(matrix_rect)
542 
543  ALLOCATE (row_dist_vec(matrix_rect%nblkrows))
544  ALLOCATE (row_size_vec(matrix_rect%nblkrows))
545  ALLOCATE (col_dist_vec(matrix_rect%nblkcols))
546  ALLOCATE (col_size_vec(matrix_rect%nblkcols))
547 
548  DO row = 1, matrix_rect%nblkrows
549  row_dist_vec(row) = matrix_rect%dist%row_dist%dist(row)
550  row_size_vec(row) = matrix_rect%row_blk_size%data(row)
551  END DO
552 
553  DO col = 1, matrix_rect%nblkcols
554  col_dist_vec(col) = matrix_rect%dist%col_dist%dist(col)
555  col_size_vec(col) = matrix_rect%col_blk_size%data(col)
556  END DO
557 
558  CALL dbm_distribution_new(dist, info%mp_comm, row_dist_vec, col_dist_vec)
559  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  col_block_sizes=col_size_vec)
566 
567  CALL dbm_distribution_release(dist)
568 
569  DEALLOCATE (row_size_vec, col_size_vec)
570 
571 !$OMP PARALLEL DEFAULT(NONE) SHARED(matrix_rect,matrix_dbm) &
572 !$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  CALL dbm_finalize(matrix_dbm)
596 
597  CALL timestop(handle)
598  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  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  INTEGER, CONTIGUOUS, DIMENSION(:), POINTER :: col_blk_size, row_blk_size
618  INTEGER, DIMENSION(2) :: pdims
619  REAL(kind=dp), DIMENSION(:, :), POINTER :: block
620  TYPE(dbm_distribution_obj) :: dbm_dist
621  TYPE(dbm_iterator) :: iter
622  TYPE(dbt_tas_blk_size_arb) :: col_blk_size_obj, row_blk_size_obj
623  TYPE(dbt_tas_dist_arb) :: col_dist_obj, row_dist_obj
624  TYPE(dbt_tas_distribution_type) :: dist
625 
626  NULLIFY (col_blk_size, row_blk_size)
627  CALL timeset(routinen, handle)
628  pdims = info%mp_comm%num_pe_cart
629 
630  name = dbm_get_name(matrix_dbm)
631  row_blk_size => dbm_get_row_block_sizes(matrix_dbm)
632  col_blk_size => dbm_get_col_block_sizes(matrix_dbm)
633 
634  nbrows = SIZE(row_blk_size)
635  nbcols = SIZE(col_blk_size)
636 
637  dbm_dist = dbm_get_distribution(matrix_dbm)
638  row_dist_obj = dbt_tas_dist_arb(dbm_distribution_row_dist(dbm_dist), pdims(1), nbrows)
639  col_dist_obj = dbt_tas_dist_arb(dbm_distribution_col_dist(dbm_dist), pdims(2), nbcols)
640 
641  row_blk_size_obj = dbt_tas_blk_size_arb(row_blk_size)
642  col_blk_size_obj = dbt_tas_blk_size_arb(col_blk_size)
643 
644  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  dist, row_blk_size_obj, col_blk_size_obj)
648 
649 !$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  CALL dbt_tas_finalize(matrix_rect)
659 
660  CALL timestop(handle)
661  END SUBROUTINE
662 
663 ! **************************************************************************************************
664 !> \brief As dbm_iterator_start
665 !> \param iter ...
666 !> \param matrix_in ...
667 !> \author Patrick Seewald
668 ! **************************************************************************************************
669  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  CALL dbm_iterator_start(iter%iter, matrix_in%matrix)
674 
675  iter%dist => matrix_in%dist
676  END SUBROUTINE
677 
678 ! **************************************************************************************************
679 !> \brief As dbm_iterator_num_blocks
680 !> \param iter ...
681 !> \return ...
682 !> \author Ole Schuett
683 ! **************************************************************************************************
684  FUNCTION dbt_tas_iterator_num_blocks(iter)
685  TYPE(dbt_tas_iterator), INTENT(IN) :: iter
686  INTEGER :: dbt_tas_iterator_num_blocks
687 
688  dbt_tas_iterator_num_blocks = dbm_iterator_num_blocks(iter%iter)
689  END FUNCTION
690 
691 ! **************************************************************************************************
692 !> \brief As dbm_iterator_blocks_left
693 !> \param iter ...
694 !> \return ...
695 !> \author Patrick Seewald
696 ! **************************************************************************************************
697  FUNCTION dbt_tas_iterator_blocks_left(iter)
698  TYPE(dbt_tas_iterator), INTENT(IN) :: iter
699  LOGICAL :: dbt_tas_iterator_blocks_left
700 
701  dbt_tas_iterator_blocks_left = dbm_iterator_blocks_left(iter%iter)
702  END FUNCTION
703 
704 ! **************************************************************************************************
705 !> \brief As dbm_iterator_stop
706 !> \param iter ...
707 !> \author Patrick Seewald
708 ! **************************************************************************************************
709  SUBROUTINE dbt_tas_iterator_stop(iter)
710  TYPE(dbt_tas_iterator), INTENT(INOUT) :: iter
711 
712  CALL dbm_iterator_stop(iter%iter)
713  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  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  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  row=row, column=column)
736 
737  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  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  INTEGER, DIMENSION(SIZE(rows)) :: columns_group, rows_group
754 
755  CALL timeset(routinen, handle)
756 
757  cpassert(SIZE(rows) == SIZE(columns))
758  DO i = 1, SIZE(rows)
759  CALL dbt_index_global_to_local(dbt_tas_info(matrix), matrix%dist, &
760  row=rows(i), row_group=rows_group(i), &
761  column=columns(i), column_group=columns_group(i))
762  END DO
763 
764  CALL dbm_reserve_blocks(matrix%matrix, rows_group, columns_group)
765 
766  CALL timestop(handle)
767  END SUBROUTINE
768 
769 ! **************************************************************************************************
770 !> \brief Copy a distribution
771 !> \param dist_in ...
772 !> \param dist_out ...
773 !> \param own_dist Whether distribution should be owned by dist_out
774 !> \author Patrick Seewald
775 ! **************************************************************************************************
776  SUBROUTINE dbt_tas_copy_distribution(dist_in, dist_out, own_dist)
777  TYPE(dbt_tas_distribution_type), INTENT(INOUT) :: dist_in
778  TYPE(dbt_tas_distribution_type), INTENT(OUT) :: dist_out
779  LOGICAL, INTENT(IN), OPTIONAL :: own_dist
780 
781  LOGICAL :: own_dist_prv
782 
783  IF (PRESENT(own_dist)) THEN
784  own_dist_prv = own_dist
785  ELSE
786  own_dist_prv = .false.
787  END IF
788 
789  IF (.NOT. own_dist_prv) THEN
790  CALL dbm_distribution_hold(dist_in%dbm_dist)
791  CALL dbt_tas_info_hold(dist_in%info)
792  END IF
793 
794  dist_out = dist_in
795  END SUBROUTINE
796 
797 ! **************************************************************************************************
798 !> \brief Get block size for a given row & column
799 !> \param matrix ...
800 !> \param row ...
801 !> \param col ...
802 !> \param row_size ...
803 !> \param col_size ...
804 !> \author Patrick Seewald
805 ! **************************************************************************************************
806  SUBROUTINE dbt_tas_blk_sizes(matrix, row, col, row_size, col_size)
807  TYPE(dbt_tas_type), INTENT(IN) :: matrix
808  INTEGER(KIND=int_8), INTENT(IN) :: row, col
809  INTEGER, INTENT(OUT) :: row_size, col_size
810 
811  row_size = matrix%row_blk_size%data(row)
812  col_size = matrix%col_blk_size%data(col)
813  END SUBROUTINE
814 
815 ! **************************************************************************************************
816 !> \brief get info on mpi grid splitting
817 !> \param matrix ...
818 !> \return ...
819 !> \author Patrick Seewald
820 ! **************************************************************************************************
821  FUNCTION dbt_tas_info(matrix)
822  TYPE(dbt_tas_type), INTENT(IN) :: matrix
823  TYPE(dbt_tas_split_info) :: dbt_tas_info
824 
825  dbt_tas_info = matrix%dist%info
826  END FUNCTION
827 
828 ! **************************************************************************************************
829 !> \brief ...
830 !> \param matrix ...
831 !> \return ...
832 !> \author Patrick Seewald
833 ! **************************************************************************************************
834  FUNCTION dbt_tas_nblkrows_total(matrix) RESULT(nblkrows_total)
835  TYPE(dbt_tas_type), INTENT(IN) :: matrix
836  INTEGER(KIND=int_8) :: nblkrows_total
837 
838  nblkrows_total = matrix%nblkrows
839  END FUNCTION
840 
841 ! **************************************************************************************************
842 !> \brief ...
843 !> \param matrix ...
844 !> \return ...
845 !> \author Patrick Seewald
846 ! **************************************************************************************************
847  FUNCTION dbt_tas_nfullrows_total(matrix) RESULT(nfullrows_total)
848  TYPE(dbt_tas_type), INTENT(IN) :: matrix
849  INTEGER(KIND=int_8) :: nfullrows_total
850 
851  nfullrows_total = matrix%nfullrows
852  END FUNCTION
853 
854 ! **************************************************************************************************
855 !> \brief ...
856 !> \param matrix ...
857 !> \return ...
858 !> \author Patrick Seewald
859 ! **************************************************************************************************
860  FUNCTION dbt_tas_nblkcols_total(matrix) RESULT(nblkcols_total)
861  TYPE(dbt_tas_type), INTENT(IN) :: matrix
862  INTEGER(KIND=int_8) :: nblkcols_total
863 
864  nblkcols_total = matrix%nblkcols
865  END FUNCTION
866 
867 ! **************************************************************************************************
868 !> \brief ...
869 !> \param matrix ...
870 !> \return ...
871 !> \author Patrick Seewald
872 ! **************************************************************************************************
873  FUNCTION dbt_tas_nfullcols_total(matrix) RESULT(nfullcols_total)
874  TYPE(dbt_tas_type), INTENT(IN) :: matrix
875  INTEGER(KIND=int_8) :: nfullcols_total
876 
877  nfullcols_total = matrix%nfullcols
878  END FUNCTION
879 
880 ! **************************************************************************************************
881 !> \brief ...
882 !> \param matrix ...
883 !> \return ...
884 !> \author Patrick Seewald
885 ! **************************************************************************************************
886  FUNCTION dbt_tas_nblkcols_local(matrix) RESULT(nblkcols_local)
887  TYPE(dbt_tas_type), INTENT(IN) :: matrix
888  INTEGER :: nblkcols_local
889 
890  nblkcols_local = SIZE(dbm_get_col_block_sizes(matrix%matrix))
891  END FUNCTION
892 
893 ! **************************************************************************************************
894 !> \brief ...
895 !> \param matrix ...
896 !> \return ...
897 !> \author Patrick Seewald
898 ! **************************************************************************************************
899  FUNCTION dbt_tas_nblkrows_local(matrix) RESULT(nblkrows_local)
900  TYPE(dbt_tas_type), INTENT(IN) :: matrix
901  INTEGER :: nblkrows_local
902 
903  nblkrows_local = SIZE(dbm_get_row_block_sizes(matrix%matrix))
904  END FUNCTION
905 
906 ! **************************************************************************************************
907 !> \brief As dbt_get_num_blocks: get number of local blocks
908 !> \param matrix ...
909 !> \return ...
910 !> \author Patrick Seewald
911 ! **************************************************************************************************
912  PURE FUNCTION dbt_tas_get_num_blocks(matrix) RESULT(num_blocks)
913  TYPE(dbt_tas_type), INTENT(IN) :: matrix
914  INTEGER :: num_blocks
915 
916  num_blocks = dbm_get_num_blocks(matrix%matrix)
917  END FUNCTION
918 
919 ! **************************************************************************************************
920 !> \brief get total number of blocks
921 !> \param matrix ...
922 !> \return ...
923 !> \author Patrick Seewald
924 ! **************************************************************************************************
925  FUNCTION dbt_tas_get_num_blocks_total(matrix) RESULT(num_blocks)
926  TYPE(dbt_tas_type), INTENT(IN) :: matrix
927  INTEGER(KIND=int_8) :: num_blocks
928 
929  TYPE(dbt_tas_split_info) :: info
930 
931  info = dbt_tas_info(matrix)
932  num_blocks = dbt_tas_get_num_blocks(matrix)
933  CALL info%mp_comm%sum(num_blocks)
934 
935  END FUNCTION
936 
937 ! **************************************************************************************************
938 !> \brief As dbt_get_nze: get number of local non-zero elements
939 !> \param matrix ...
940 !> \return ...
941 !> \author Patrick Seewald
942 ! **************************************************************************************************
943  PURE FUNCTION dbt_tas_get_nze(matrix)
944  TYPE(dbt_tas_type), INTENT(IN) :: matrix
945  INTEGER :: dbt_tas_get_nze
946 
947  dbt_tas_get_nze = dbm_get_nze(matrix%matrix)
948 
949  END FUNCTION
950 
951 ! **************************************************************************************************
952 !> \brief Get total number of non-zero elements
953 !> \param matrix ...
954 !> \return ...
955 !> \author Patrick Seewald
956 ! **************************************************************************************************
957  FUNCTION dbt_tas_get_nze_total(matrix)
958  TYPE(dbt_tas_type), INTENT(IN) :: matrix
959  INTEGER(KIND=int_8) :: dbt_tas_get_nze_total
960 
961  TYPE(dbt_tas_split_info) :: info
962 
963  dbt_tas_get_nze_total = dbt_tas_get_nze(matrix)
964  info = dbt_tas_info(matrix)
965  CALL info%mp_comm%sum(dbt_tas_get_nze_total)
966  END FUNCTION
967 
968 ! **************************************************************************************************
969 !> \brief Clear matrix (erase all data)
970 !> \param matrix ...
971 !> \author Patrick Seewald
972 ! **************************************************************************************************
973  SUBROUTINE dbt_tas_clear(matrix)
974  TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
975 
976  CALL dbm_clear(matrix%matrix)
977  END SUBROUTINE
978 
979 ! **************************************************************************************************
980 !> \brief ...
981 !> \param matrix ...
982 !> \param nblkrows_total ...
983 !> \param nblkcols_total ...
984 !> \param local_rows ...
985 !> \param local_cols ...
986 !> \param proc_row_dist ...
987 !> \param proc_col_dist ...
988 !> \param row_blk_size ...
989 !> \param col_blk_size ...
990 !> \param distribution ...
991 !> \param name ...
992 !> \author Patrick Seewald
993 ! **************************************************************************************************
994  SUBROUTINE dbt_tas_get_info(matrix, &
995  nblkrows_total, nblkcols_total, &
996  local_rows, local_cols, &
997  proc_row_dist, proc_col_dist, &
998  row_blk_size, col_blk_size, distribution, name)
999 
1000  TYPE(dbt_tas_type), INTENT(IN) :: matrix
1001  INTEGER(KIND=int_8), INTENT(OUT), OPTIONAL :: nblkrows_total, nblkcols_total
1002  INTEGER(KIND=int_8), ALLOCATABLE, DIMENSION(:), &
1003  OPTIONAL :: local_rows, local_cols
1004 
1005  CLASS(dbt_tas_distribution), ALLOCATABLE, OPTIONAL, &
1006  INTENT(OUT) :: proc_row_dist, proc_col_dist
1007  CLASS(dbt_tas_rowcol_data), ALLOCATABLE, OPTIONAL, &
1008  INTENT(OUT) :: row_blk_size, col_blk_size
1009  TYPE(dbt_tas_distribution_type), OPTIONAL :: distribution
1010  CHARACTER(len=*), INTENT(OUT), OPTIONAL :: name
1011 
1012  TYPE(dbt_tas_split_info) :: info
1013  INTEGER :: irow, icol
1014  INTEGER, ALLOCATABLE, DIMENSION(:) :: local_rows_local, local_cols_local
1015 
1016  info = dbt_tas_info(matrix)
1017 
1018  IF (PRESENT(local_rows)) THEN
1019  CALL dbm_get_local_rows(matrix%matrix, local_rows_local)
1020  ALLOCATE (local_rows(SIZE(local_rows_local)))
1021  DO irow = 1, SIZE(local_rows_local)
1022  CALL dbt_index_local_to_global(info, matrix%dist, row_group=local_rows_local(irow), row=local_rows(irow))
1023  END DO
1024  END IF
1025 
1026  IF (PRESENT(local_cols)) THEN
1027  CALL dbm_get_local_cols(matrix%matrix, local_cols_local)
1028  ALLOCATE (local_cols(SIZE(local_cols_local)))
1029  DO icol = 1, SIZE(local_cols_local)
1030  CALL dbt_index_local_to_global(info, matrix%dist, column_group=local_cols_local(icol), column=local_cols(icol))
1031  END DO
1032  END IF
1033 
1034  IF (PRESENT(name)) name = dbm_get_name(matrix%matrix)
1035  IF (PRESENT(nblkrows_total)) nblkrows_total = dbt_tas_nblkrows_total(matrix)
1036  IF (PRESENT(nblkcols_total)) nblkcols_total = dbt_tas_nblkcols_total(matrix)
1037  IF (PRESENT(proc_row_dist)) ALLOCATE (proc_row_dist, source=matrix%dist%row_dist)
1038  IF (PRESENT(proc_col_dist)) ALLOCATE (proc_col_dist, source=matrix%dist%col_dist)
1039  IF (PRESENT(row_blk_size)) ALLOCATE (row_blk_size, source=matrix%row_blk_size)
1040  IF (PRESENT(col_blk_size)) ALLOCATE (col_blk_size, source=matrix%col_blk_size)
1041  IF (PRESENT(distribution)) distribution = matrix%dist
1042 
1043  END SUBROUTINE
1044 
1045 ! **************************************************************************************************
1046 !> \brief As dbm_iterator_next_block
1047 !> \param iterator ...
1048 !> \param row ...
1049 !> \param column ...
1050 !> \param block ...
1051 !> \param row_size ...
1052 !> \param col_size ...
1053 !> \author Patrick Seewald
1054 ! **************************************************************************************************
1055  SUBROUTINE dbt_tas_iterator_next_block_d(iterator, row, column, block, row_size, col_size)
1056  TYPE(dbt_tas_iterator), INTENT(INOUT) :: iterator
1057  INTEGER(KIND=int_8), INTENT(OUT) :: row, column
1058  REAL(dp), DIMENSION(:, :), POINTER :: block
1059  INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size
1060 
1061  INTEGER :: column_group, row_group
1062 
1063  CALL dbm_iterator_next_block(iterator%iter, row_group, column_group, block, &
1064  row_size=row_size, col_size=col_size)
1065 
1066  CALL dbt_index_local_to_global(iterator%dist%info, iterator%dist, row_group=row_group, column_group=column_group, &
1067  row=row, column=column)
1068 
1069  END SUBROUTINE
1070 
1071 ! **************************************************************************************************
1072 !> \brief As dbm_put_block
1073 !> \param matrix ...
1074 !> \param row ...
1075 !> \param col ...
1076 !> \param block ...
1077 !> \param summation ...
1078 !> \author Patrick Seewald
1079 ! **************************************************************************************************
1080  SUBROUTINE dbt_tas_put_block(matrix, row, col, block, summation)
1081  TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
1082  INTEGER(KIND=int_8), INTENT(IN) :: row, col
1083  REAL(dp), DIMENSION(:, :), INTENT(IN) :: block
1084  LOGICAL, INTENT(IN), OPTIONAL :: summation
1085 
1086  INTEGER :: col_group, row_group
1087 
1088  CALL dbt_index_global_to_local(matrix%dist%info, matrix%dist, row=row, column=col, &
1089  row_group=row_group, column_group=col_group)
1090 
1091  CALL dbm_put_block(matrix%matrix, row_group, col_group, block, summation=summation)
1092 
1093  END SUBROUTINE
1094 
1095 ! **************************************************************************************************
1096 !> \brief As dbm_get_block_p
1097 !> \param matrix ...
1098 !> \param row ...
1099 !> \param col ...
1100 !> \param block ...
1101 !> \param row_size ...
1102 !> \param col_size ...
1103 !> \author Patrick Seewald
1104 ! **************************************************************************************************
1105  SUBROUTINE dbt_tas_get_block_p(matrix, row, col, block, row_size, col_size)
1106  TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
1107  INTEGER(KIND=int_8), INTENT(IN) :: row, col
1108  REAL(dp), DIMENSION(:, :), POINTER :: block
1109  INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size
1110 
1111  INTEGER :: col_group, row_group
1112 
1113  CALL dbt_index_global_to_local(matrix%dist%info, matrix%dist, row=row, column=col, &
1114  row_group=row_group, column_group=col_group)
1115 
1116  CALL dbm_get_block_p(matrix%matrix, row_group, col_group, block, &
1117  row_size=row_size, col_size=col_size)
1118 
1119  END SUBROUTINE
1120 
1121 ! **************************************************************************************************
1122 !> \brief As dbm_filter
1123 !> \param matrix ...
1124 !> \param eps ...
1125 !> \author Patrick Seewald
1126 ! **************************************************************************************************
1127  SUBROUTINE dbt_tas_filter(matrix, eps)
1128  TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
1129  REAL(dp), INTENT(IN) :: eps
1130 
1131  CALL dbm_filter(matrix%matrix, eps)
1132 
1133  END SUBROUTINE
1134 
1135 END MODULE
dbm_distribution_new
void dbm_distribution_new(dbm_distribution_t **dist_out, const int fortran_comm, const int nrows, const int ncols, const int row_dist[nrows], const int col_dist[ncols])
Creates a new two dimensional distribution.
Definition: dbm_distribution.c:103
dbm_distribution_hold
void dbm_distribution_hold(dbm_distribution_t *dist)
Increases the reference counter of the given distribution.
Definition: dbm_distribution.c:136
dbm_distribution_release
void dbm_distribution_release(dbm_distribution_t *dist)
Decreases the reference counter of the given distribution.
Definition: dbm_distribution.c:145
dbm_distribution_row_dist
void dbm_distribution_row_dist(const dbm_distribution_t *dist, int *nrows, const int **row_dist)
Returns the rows of the given distribution.
Definition: dbm_distribution.c:159
dbm_distribution_col_dist
void dbm_distribution_col_dist(const dbm_distribution_t *dist, int *ncols, const int **col_dist)
Returns the columns of the given distribution.
Definition: dbm_distribution.c:170
dbm_get_block_p
void dbm_get_block_p(dbm_matrix_t *matrix, const int row, const int col, double **block, int *row_size, int *col_size)
Looks up a block from given matrics. This routine is thread-safe. If the block is not found then a nu...
Definition: dbm_matrix.c:206
dbm_reserve_blocks
void dbm_reserve_blocks(dbm_matrix_t *matrix, const int nblocks, const int rows[], const int cols[])
Adds list of blocks efficiently. The blocks will be filled with zeros. This routine must always be ca...
Definition: dbm_matrix.c:325
dbm_iterator_blocks_left
bool dbm_iterator_blocks_left(const dbm_iterator_t *iter)
Tests whether the given iterator has any block left.
Definition: dbm_matrix.c:459
dbm_filter
void dbm_filter(dbm_matrix_t *matrix, const double eps)
Removes all blocks from the matrix whose norm is below the threshold. Blocks of size zero are always ...
Definition: dbm_matrix.c:276
dbm_get_local_cols
void dbm_get_local_cols(const dbm_matrix_t *matrix, int *nlocal_cols, const int **local_cols)
Returns the local column block sizes of the given matrix.
Definition: dbm_matrix.c:595
dbm_get_local_rows
void dbm_get_local_rows(const dbm_matrix_t *matrix, int *nlocal_rows, const int **local_rows)
Returns the local row block sizes of the given matrix.
Definition: dbm_matrix.c:585
dbm_iterator_stop
void dbm_iterator_stop(dbm_iterator_t *iter)
Releases the given iterator.
Definition: dbm_matrix.c:497
dbm_create
void dbm_create(dbm_matrix_t **matrix_out, dbm_distribution_t *dist, const char name[], const int nrows, const int ncols, const int row_sizes[nrows], const int col_sizes[ncols])
Creates a new matrix.
Definition: dbm_matrix.c:24
dbm_get_name
const char * dbm_get_name(const dbm_matrix_t *matrix)
Returns the name of the matrix of the given matrix.
Definition: dbm_matrix.c:535
dbm_put_block
void dbm_put_block(dbm_matrix_t *matrix, const int row, const int col, const bool summation, const double *block)
Adds a block to given matrix. This routine is thread-safe. If block already exist then it gets overwr...
Definition: dbm_matrix.c:228
dbm_iterator_num_blocks
int dbm_iterator_num_blocks(const dbm_iterator_t *iter)
Returns number of blocks the iterator will provide to calling thread.
Definition: dbm_matrix.c:445
dbm_iterator_start
void dbm_iterator_start(dbm_iterator_t **iter_out, const dbm_matrix_t *matrix)
Creates an iterator for the blocks of the given matrix. The iteration order is not stable....
Definition: dbm_matrix.c:426
dbm_iterator_next_block
void dbm_iterator_next_block(dbm_iterator_t *iter, int *row, int *col, double **block, int *row_size, int *col_size)
Returns the next block from the given iterator.
Definition: dbm_matrix.c:467
dbm_get_num_blocks
int dbm_get_num_blocks(const dbm_matrix_t *matrix)
Returns the number of local blocks of the given matrix.
Definition: dbm_matrix.c:553
dbm_clear
void dbm_clear(dbm_matrix_t *matrix)
Remove all blocks from matrix, but does not release underlying memory.
Definition: dbm_matrix.c:257
dbm_get_nze
int dbm_get_nze(const dbm_matrix_t *matrix)
Returns the number of local Non-Zero Elements of the given matrix.
Definition: dbm_matrix.c:541
dbm_release
void dbm_release(dbm_matrix_t *matrix)
Releases a matrix and all its ressources.
Definition: dbm_matrix.c:65
dbm_get_distribution
const dbm_distribution_t * dbm_get_distribution(const dbm_matrix_t *matrix)
Returns the distribution of the given matrix.
Definition: dbm_matrix.c:614
dbm_api
Definition: dbm_api.F:8
dbm_api::dbm_clear
subroutine, public dbm_clear(matrix)
Remove all blocks from given matrix, but does not release the underlying memory.
Definition: dbm_api.F:529
dbm_api::dbm_create_from_template
subroutine, public dbm_create_from_template(matrix, name, template)
Creates a new matrix from given template, reusing dist and row/col_block_sizes.
Definition: dbm_api.F:265
dbm_api::dbm_get_nze
pure integer function, public dbm_get_nze(matrix)
Returns the number of local Non-Zero Elements of the given matrix.
Definition: dbm_api.F:1057
dbm_api::dbm_get_local_cols
subroutine, public dbm_get_local_cols(matrix, local_cols)
Returns the local column block sizes of the given matrix.
Definition: dbm_api.F:1195
dbm_api::dbm_distribution_release
subroutine, public dbm_distribution_release(dist)
Decreases the reference counter of the given distribution.
Definition: dbm_api.F:1401
dbm_api::dbm_iterator_next_block
subroutine, public dbm_iterator_next_block(iterator, row, column, block, row_size, col_size)
Returns the next block from the given iterator.
Definition: dbm_api.F:910
dbm_api::dbm_filter
subroutine, public dbm_filter(matrix, eps)
Removes all blocks from the given matrix whose block norm is below the given threshold....
Definition: dbm_api.F:555
dbm_api::dbm_iterator_num_blocks
integer function, public dbm_iterator_num_blocks(iterator)
Returns number of blocks the iterator will provide to calling thread.
Definition: dbm_api.F:862
dbm_api::dbm_get_distribution
type(dbm_distribution_obj) function, public dbm_get_distribution(matrix)
Returns the distribution of the given matrix.
Definition: dbm_api.F:1266
dbm_api::dbm_create
subroutine, public dbm_create(matrix, name, dist, row_block_sizes, col_block_sizes)
Creates a new matrix.
Definition: dbm_api.F:293
dbm_api::dbm_get_row_block_sizes
integer function, dimension(:), pointer, contiguous, public dbm_get_row_block_sizes(matrix)
Returns the row block sizes of the given matrix.
Definition: dbm_api.F:1103
dbm_api::dbm_iterator_blocks_left
logical function, public dbm_iterator_blocks_left(iterator)
Tests whether the given iterator has any block left.
Definition: dbm_api.F:884
dbm_api::dbm_distribution_col_dist
integer function, dimension(:), pointer, contiguous, public dbm_distribution_col_dist(dist)
Returns the columns of the given distribution.
Definition: dbm_api.F:1455
dbm_api::dbm_reserve_blocks
subroutine, public dbm_reserve_blocks(matrix, rows, cols)
Adds given list of blocks efficiently. The blocks will be filled with zeros.
Definition: dbm_api.F:589
dbm_api::dbm_iterator_stop
subroutine, public dbm_iterator_stop(iterator)
Releases the given iterator.
Definition: dbm_api.F:948
dbm_api::dbm_get_local_rows
subroutine, public dbm_get_local_rows(matrix, local_rows)
Returns the local row block sizes of the given matrix.
Definition: dbm_api.F:1158
dbm_api::dbm_put_block
subroutine, public dbm_put_block(matrix, row, col, block, summation)
Adds a block to given matrix. This routine is thread-safe. If block already exist then it gets overwr...
Definition: dbm_api.F:491
dbm_api::dbm_get_name
character(len=default_string_length) function, public dbm_get_name(matrix)
Returns the name of the matrix of the given matrix.
Definition: dbm_api.F:1023
dbm_api::dbm_finalize
subroutine, public dbm_finalize(matrix)
Needed to be called for DBCSR after blocks where inserted. For DBM it's a no-opt.
Definition: dbm_api.F:339
dbm_api::dbm_iterator_start
subroutine, public dbm_iterator_start(iterator, matrix)
Creates an iterator for the blocks of the given matrix. The iteration order is not stable.
Definition: dbm_api.F:837
dbm_api::dbm_get_num_blocks
pure integer function, public dbm_get_num_blocks(matrix)
Returns the number of local blocks of the given matrix.
Definition: dbm_api.F:1080
dbm_api::dbm_distribution_hold
subroutine, public dbm_distribution_hold(dist)
Increases the reference counter of the given distribution.
Definition: dbm_api.F:1378
dbm_api::dbm_release
subroutine, public dbm_release(matrix)
Releases a matrix and all its ressources.
Definition: dbm_api.F:354
dbm_api::dbm_get_col_block_sizes
integer function, dimension(:), pointer, contiguous, public dbm_get_col_block_sizes(matrix)
Returns the column block sizes of the given matrix.
Definition: dbm_api.F:1130
dbm_api::dbm_distribution_row_dist
integer function, dimension(:), pointer, contiguous, public dbm_distribution_row_dist(dist)
Returns the rows of the given distribution.
Definition: dbm_api.F:1425
dbm_api::dbm_distribution_new
subroutine, public dbm_distribution_new(dist, mp_comm, row_dist_block, col_dist_block)
Creates a new two dimensional distribution.
Definition: dbm_api.F:1294
dbm_api::dbm_get_block_p
subroutine, public dbm_get_block_p(matrix, row, col, block, row_size, col_size)
Looks up a block from given matrics. This routine is thread-safe. If the block is not found then a nu...
Definition: dbm_api.F:449
dbt_tas_base
Tall-and-skinny matrices: base routines similar to DBM API, mostly wrappers around existing DBM routi...
Definition: dbt_tas_base.F:13
dbt_tas_base::dbt_tas_blk_sizes
subroutine, public dbt_tas_blk_sizes(matrix, row, col, row_size, col_size)
Get block size for a given row & column.
Definition: dbt_tas_base.F:807
dbt_tas_base::dbt_tas_get_nze_total
integer(kind=int_8) function, public dbt_tas_get_nze_total(matrix)
Get total number of non-zero elements.
Definition: dbt_tas_base.F:958
dbt_tas_base::dbt_tas_convert_to_dbm
subroutine, public dbt_tas_convert_to_dbm(matrix_rect, matrix_dbm)
Convert a tall-and-skinny matrix into a normal DBM matrix. This is not recommended for matrices with ...
Definition: dbt_tas_base.F:524
dbt_tas_base::dbt_tas_distribution_destroy
subroutine, public dbt_tas_distribution_destroy(dist)
...
Definition: dbt_tas_base.F:433
dbt_tas_base::dbt_tas_iterator_num_blocks
integer function, public dbt_tas_iterator_num_blocks(iter)
As dbm_iterator_num_blocks.
Definition: dbt_tas_base.F:685
dbt_tas_base::dbt_tas_get_stored_coordinates
subroutine, public dbt_tas_get_stored_coordinates(matrix, row, column, processor)
As dbt_get_stored_coordinates.
Definition: dbt_tas_base.F:462
dbt_tas_base::dbt_tas_iterator_start
subroutine, public dbt_tas_iterator_start(iter, matrix_in)
As dbm_iterator_start.
Definition: dbt_tas_base.F:670
dbt_tas_base::dbt_tas_iterator_blocks_left
logical function, public dbt_tas_iterator_blocks_left(iter)
As dbm_iterator_blocks_left.
Definition: dbt_tas_base.F:698
dbt_tas_base::dbt_repl_get_stored_coordinates
subroutine, public dbt_repl_get_stored_coordinates(matrix, row, column, processors)
Get all processors for a given row/col combination if matrix is replicated on each process subgroup.
Definition: dbt_tas_base.F:488
dbt_tas_base::dbt_tas_get_nze
pure integer function, public dbt_tas_get_nze(matrix)
As dbt_get_nze: get number of local non-zero elements.
Definition: dbt_tas_base.F:944
dbt_tas_base::dbt_tas_nblkrows_total
integer(kind=int_8) function, public dbt_tas_nblkrows_total(matrix)
...
Definition: dbt_tas_base.F:835
dbt_tas_base::dbt_tas_get_info
subroutine, public dbt_tas_get_info(matrix, nblkrows_total, nblkcols_total, local_rows, local_cols, proc_row_dist, proc_col_dist, row_blk_size, col_blk_size, distribution, name)
...
Definition: dbt_tas_base.F:999
dbt_tas_base::dbt_tas_nblkcols_local
integer function, public dbt_tas_nblkcols_local(matrix)
...
Definition: dbt_tas_base.F:887
dbt_tas_base::dbt_tas_nfullrows_total
integer(kind=int_8) function, public dbt_tas_nfullrows_total(matrix)
...
Definition: dbt_tas_base.F:848
dbt_tas_base::dbt_tas_copy
subroutine, public dbt_tas_copy(matrix_b, matrix_a, summation)
Copy matrix_a to matrix_b.
Definition: dbt_tas_base.F:250
dbt_tas_base::dbt_tas_iterator_stop
subroutine, public dbt_tas_iterator_stop(iter)
As dbm_iterator_stop.
Definition: dbt_tas_base.F:710
dbt_tas_base::dbt_tas_finalize
subroutine, public dbt_tas_finalize(matrix)
...
Definition: dbt_tas_base.F:327
dbt_tas_base::dbt_tas_nfullcols_total
integer(kind=int_8) function, public dbt_tas_nfullcols_total(matrix)
...
Definition: dbt_tas_base.F:874
dbt_tas_base::dbt_tas_distribution_new
subroutine, public dbt_tas_distribution_new(dist, mp_comm, row_dist, col_dist, split_info, nosplit)
create new distribution. Exactly like dbm_distribution_new but with custom types for row_dist and col...
Definition: dbt_tas_base.F:346
dbt_tas_base::dbt_tas_info
type(dbt_tas_split_info) function, public dbt_tas_info(matrix)
get info on mpi grid splitting
Definition: dbt_tas_base.F:822
dbt_tas_base::dbt_tas_nblkcols_total
integer(kind=int_8) function, public dbt_tas_nblkcols_total(matrix)
...
Definition: dbt_tas_base.F:861
dbt_tas_base::dbt_tas_filter
subroutine, public dbt_tas_filter(matrix, eps)
As dbm_filter.
Definition: dbt_tas_base.F:1128
dbt_tas_base::dbt_tas_clear
subroutine, public dbt_tas_clear(matrix)
Clear matrix (erase all data)
Definition: dbt_tas_base.F:974
dbt_tas_base::dbt_tas_destroy
subroutine, public dbt_tas_destroy(matrix)
...
Definition: dbt_tas_base.F:233
dbt_tas_base::dbt_tas_get_num_blocks_total
integer(kind=int_8) function, public dbt_tas_get_num_blocks_total(matrix)
get total number of blocks
Definition: dbt_tas_base.F:926
dbt_tas_base::dbt_tas_get_num_blocks
pure integer function, public dbt_tas_get_num_blocks(matrix)
As dbt_get_num_blocks: get number of local blocks.
Definition: dbt_tas_base.F:913
dbt_tas_base::dbt_tas_put_block
subroutine, public dbt_tas_put_block(matrix, row, col, block, summation)
As dbm_put_block.
Definition: dbt_tas_base.F:1081
dbt_tas_base::dbt_tas_nblkrows_local
integer function, public dbt_tas_nblkrows_local(matrix)
...
Definition: dbt_tas_base.F:900
dbt_tas_base::dbt_tas_get_block_p
subroutine, public dbt_tas_get_block_p(matrix, row, col, block, row_size, col_size)
As dbm_get_block_p.
Definition: dbt_tas_base.F:1106
dbt_tas_base::dbt_tas_convert_to_tas
subroutine, public dbt_tas_convert_to_tas(info, matrix_rect, matrix_dbm)
Converts a DBM matrix into the tall-and-skinny matrix type.
Definition: dbt_tas_base.F:608
dbt_tas_global
Global data (distribution and block sizes) for tall-and-skinny matrices For very sparse matrices with...
Definition: dbt_tas_global.F:17
dbt_tas_split
methods to split tall-and-skinny matrices along longest dimension. Basically, we are splitting proces...
Definition: dbt_tas_split.F:13
dbt_tas_split::dbt_index_global_to_local
subroutine, public dbt_index_global_to_local(info, dist, row, column, row_group, column_group)
map global block index to group local index
Definition: dbt_tas_split.F:622
dbt_tas_split::group_to_mrowcol
subroutine, public group_to_mrowcol(info, rowcol_dist, igroup, rowcols)
maps a process subgroup to matrix rows/columns
Definition: dbt_tas_split.F:678
dbt_tas_split::dbt_tas_release_info
subroutine, public dbt_tas_release_info(split_info)
...
Definition: dbt_tas_split.F:457
dbt_tas_split::dbt_index_local_to_global
subroutine, public dbt_index_local_to_global(info, dist, row_group, column_group, row, column)
map group local block index to global matrix index
Definition: dbt_tas_split.F:592
dbt_tas_split::rowsplit
integer, parameter, public rowsplit
Definition: dbt_tas_split.F:50
dbt_tas_split::colsplit
integer, parameter, public colsplit
Definition: dbt_tas_split.F:50
dbt_tas_split::dbt_tas_create_split
subroutine, public dbt_tas_create_split(split_info, mp_comm, split_rowcol, nsplit, own_comm, opt_nsplit)
Split Cartesian process grid using a default split heuristic.
Definition: dbt_tas_split.F:333
dbt_tas_split::dbt_tas_info_hold
subroutine, public dbt_tas_info_hold(split_info)
...
Definition: dbt_tas_split.F:492
dbt_tas_types
DBT tall-and-skinny base types. Mostly wrappers around existing DBM routines.
Definition: dbt_tas_types.F:13
kinds
Defines the basic variable types.
Definition: kinds.F:23
kinds::int_8
integer, parameter, public int_8
Definition: kinds.F:54
kinds::dp
integer, parameter, public dp
Definition: kinds.F:34
kinds::default_string_length
integer, parameter, public default_string_length
Definition: kinds.F:57
message_passing
Interface to the message passing library MPI.
Definition: message_passing.F:23