(git:b195825)
dbm_api.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: BSD-3-Clause !
6 !--------------------------------------------------------------------------------------------------!
7 
8 MODULE dbm_api
9  USE iso_c_binding, ONLY: c_associated, c_bool, c_char, c_double, c_f_pointer, c_funloc, c_funptr, &
10  c_int, c_int64_t, c_null_char, c_null_ptr, c_ptr
11  USE kinds, ONLY: default_string_length, &
12  dp, &
13  int_8
14  USE message_passing, ONLY: mp_cart_type, &
15  mp_comm_type
16  USE string_utilities, ONLY: strlcpy_c2f
17 
18 ! Uncomment the following line to enable validation.
19 !#define DBM_VALIDATE_AGAINST_DBCSR
20 #define DBM_VALIDATE_NBLOCKS_MATCH .TRUE.
21 #define DBM_VALIDATE_THRESHOLD 5e-10_dp
22 
23 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
24  USE dbcsr_block_access, ONLY: dbcsr_get_block_p, &
25  dbcsr_put_block, &
26  dbcsr_reserve_blocks
27  USE dbcsr_dist_methods, ONLY: dbcsr_distribution_col_dist, &
28  dbcsr_distribution_hold, &
29  dbcsr_distribution_new, &
30  dbcsr_distribution_release, &
31  dbcsr_distribution_row_dist
32  USE dbcsr_dist_operations, ONLY: dbcsr_get_stored_coordinates
33  USE dbcsr_dist_util, ONLY: dbcsr_checksum
34  USE dbcsr_iterator_operations, ONLY: dbcsr_iterator_blocks_left, &
35  dbcsr_iterator_next_block, &
36  dbcsr_iterator_start, &
37  dbcsr_iterator_stop
38  USE dbcsr_methods, ONLY: dbcsr_col_block_sizes, &
39  dbcsr_get_num_blocks, &
40  dbcsr_get_nze, &
41  dbcsr_mp_release, &
42  dbcsr_release, &
43  dbcsr_row_block_sizes
44  USE dbcsr_mp_methods, ONLY: dbcsr_mp_new
45  USE dbcsr_multiply_api, ONLY: dbcsr_multiply
46  USE dbcsr_operations, ONLY: dbcsr_add, &
47  dbcsr_clear, &
48  dbcsr_copy, &
49  dbcsr_filter, &
50  dbcsr_get_info, &
51  dbcsr_maxabs, &
52  dbcsr_scale, &
53  dbcsr_zero
54  USE dbcsr_transformations, ONLY: dbcsr_redistribute
55  USE dbcsr_types, ONLY: dbcsr_distribution_obj, &
56  dbcsr_iterator, &
57  dbcsr_mp_obj, &
58  dbcsr_no_transpose, &
59  dbcsr_transpose, &
60  dbcsr_type, &
61  dbcsr_type_no_symmetry, &
62  dbcsr_type_real_8
63  USE dbcsr_work_operations, ONLY: dbcsr_create, &
64  dbcsr_finalize
65  USE dbcsr_data_methods, ONLY: dbcsr_scalar
66 #endif
67 
68 #include "../base/base_uses.f90"
69 
70  IMPLICIT NONE
71 
72  PRIVATE
73 
74  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'dbm_api'
75 
76  PUBLIC :: dbm_distribution_obj
77  PUBLIC :: dbm_distribution_new
78  PUBLIC :: dbm_distribution_hold
79  PUBLIC :: dbm_distribution_release
80  PUBLIC :: dbm_distribution_col_dist
81  PUBLIC :: dbm_distribution_row_dist
82 
83  PUBLIC :: dbm_iterator
84  PUBLIC :: dbm_iterator_start
85  PUBLIC :: dbm_iterator_stop
86  PUBLIC :: dbm_iterator_num_blocks
87  PUBLIC :: dbm_iterator_blocks_left
88  PUBLIC :: dbm_iterator_next_block
89 
90  PUBLIC :: dbm_type
91  PUBLIC :: dbm_release
92  PUBLIC :: dbm_create
93  PUBLIC :: dbm_create_from_template
94  PUBLIC :: dbm_clear
95  PUBLIC :: dbm_scale
96  PUBLIC :: dbm_get_block_p
97  PUBLIC :: dbm_put_block
98  PUBLIC :: dbm_reserve_blocks
99  PUBLIC :: dbm_filter
100  PUBLIC :: dbm_finalize
101  PUBLIC :: dbm_multiply
102  PUBLIC :: dbm_redistribute
103  PUBLIC :: dbm_copy
104  PUBLIC :: dbm_add
105  PUBLIC :: dbm_maxabs
106  PUBLIC :: dbm_zero
107  PUBLIC :: dbm_checksum
108  PUBLIC :: dbm_get_name
109  PUBLIC :: dbm_get_distribution
110  PUBLIC :: dbm_get_num_blocks
111  PUBLIC :: dbm_get_nze
112  PUBLIC :: dbm_get_stored_coordinates
113  PUBLIC :: dbm_get_row_block_sizes
114  PUBLIC :: dbm_get_col_block_sizes
115  PUBLIC :: dbm_get_local_rows
116  PUBLIC :: dbm_get_local_cols
117 
118  PUBLIC :: dbm_library_init
119  PUBLIC :: dbm_library_finalize
120  PUBLIC :: dbm_library_print_stats
121 
122  TYPE dbm_distribution_obj
123  PRIVATE
124  TYPE(C_PTR) :: c_ptr = c_null_ptr
125 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
126  TYPE(dbcsr_distribution_obj) :: dbcsr
127 #endif
128  END TYPE dbm_distribution_obj
129 
130  TYPE dbm_type
131  PRIVATE
132  TYPE(C_PTR) :: c_ptr = c_null_ptr
133 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
134  TYPE(dbcsr_type) :: dbcsr
135 #endif
136  END TYPE dbm_type
137 
138  TYPE dbm_iterator
139  PRIVATE
140  TYPE(C_PTR) :: c_ptr = c_null_ptr
141  END TYPE dbm_iterator
142 
143 CONTAINS
144 
145 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
146 ! **************************************************************************************************
147 !> \brief Compates the given DBM matrix against its shadow DBCSR matrics.
148 !> \param matrix ...
149 !> \author Ole Schuett
150 ! **************************************************************************************************
151  SUBROUTINE validate(matrix)
152  TYPE(dbm_type), INTENT(IN) :: matrix
153 
154  INTEGER :: col, col_size, col_size_dbcsr, i, j, &
155  num_blocks, num_blocks_dbcsr, &
156  num_blocks_diff, row, row_size, &
157  row_size_dbcsr
158  INTEGER, ALLOCATABLE, DIMENSION(:) :: local_cols, local_rows
159  LOGICAL :: transposed
160  REAL(dp) :: norm2, rel_diff
161  REAL(dp), DIMENSION(:, :), POINTER :: block, block_dbcsr
162  TYPE(C_PTR) :: block_c
163  TYPE(dbcsr_iterator) :: iter
164  INTERFACE
165  SUBROUTINE dbm_get_block_p_c(matrix, row, col, block, row_size, col_size) &
166  BIND(C, name="dbm_get_block_p")
167  IMPORT :: c_ptr, c_int
168  TYPE(C_PTR), VALUE :: matrix
169  INTEGER(kind=C_INT), VALUE :: row
170  INTEGER(kind=C_INT), VALUE :: col
171  TYPE(C_PTR) :: block
172  INTEGER(kind=C_INT) :: row_size
173  INTEGER(kind=C_INT) :: col_size
174  END SUBROUTINE dbm_get_block_p_c
175  END INTERFACE
176 
177  ! Call some getters to run their validation code.
178  CALL dbm_get_local_rows(matrix, local_rows)
179  CALL dbm_get_local_cols(matrix, local_cols)
180 
181  num_blocks_dbcsr = dbcsr_get_num_blocks(matrix%dbcsr)
182  num_blocks = dbm_get_num_blocks(matrix)
183  num_blocks_diff = abs(num_blocks - num_blocks_dbcsr)
184  IF (num_blocks_diff /= 0) THEN
185  WRITE (*, *) "num_blocks mismatch dbcsr:", num_blocks_dbcsr, "new:", num_blocks
186  IF (dbm_validate_nblocks_match) &
187  cpabort("num_blocks mismatch")
188  END IF
189 
190  IF (dbm_validate_nblocks_match) THEN
191  cpassert(dbm_get_nze(matrix) == dbcsr_get_nze(matrix%dbcsr))
192  END IF
193 
194  ! check all dbcsr blocks
195  norm2 = 0.0_dp
196  CALL dbcsr_iterator_start(iter, matrix%dbcsr)
197  DO WHILE (dbcsr_iterator_blocks_left(iter))
198  CALL dbcsr_iterator_next_block(iter, row=row, column=col, block=block_dbcsr, &
199  transposed=transposed, &
200  row_size=row_size_dbcsr, col_size=col_size_dbcsr)
201  cpassert(.NOT. transposed)
202  CALL dbm_get_block_p_c(matrix=matrix%c_ptr, row=row - 1, col=col - 1, &
203  block=block_c, row_size=row_size, col_size=col_size)
204 
205  cpassert(row_size == row_size_dbcsr .AND. col_size == col_size_dbcsr)
206  IF (SIZE(block_dbcsr) == 0) THEN
207  cycle
208  END IF
209  IF (.NOT. c_associated(block_c)) THEN
210  cpassert(maxval(abs(block_dbcsr)) < dbm_validate_threshold)
211  cycle
212  END IF
213 
214  CALL c_f_pointer(block_c, block, shape=(/row_size, col_size/))
215  DO i = 1, row_size
216  DO j = 1, col_size
217  rel_diff = abs(block(i, j) - block_dbcsr(i, j))/max(1.0_dp, abs(block_dbcsr(i, j)))
218  IF (rel_diff > dbm_validate_threshold) THEN
219  WRITE (*, *) "row:", row, "col:", col, "i:", i, "j:", j, "rel_diff:", rel_diff
220  WRITE (*, *) "values dbcsr:", block_dbcsr(i, j), "new:", block(i, j)
221  cpabort("block value mismatch")
222  END IF
223  END DO
224  END DO
225  norm2 = norm2 + sum(block**2)
226  block_dbcsr(:, :) = block(:, :) ! quench numerical noise
227  END DO
228  CALL dbcsr_iterator_stop(iter)
229 
230  ! Can not call dbcsr_get_block_p because it's INTENT(INOUT) :-(
231 
232  !! At least check that the norm (=checksum) of excesive blocks is small.
233  !TODO: sum norm2 across all mpi ranks.
234  !TODO: re-add INTERFACE to dbm_checksum_c, which got removed by prettify.
235  !rel_diff = ABS(dbm_checksum_c(matrix%c_ptr) - norm2)/MAX(1.0_dp, norm2)
236  !IF (rel_diff > DBM_VALIDATE_THRESHOLD) THEN
237  ! WRITE (*, *) "num_blocks dbcsr:", num_blocks_dbcsr, "new:", num_blocks
238  ! WRITE (*, *) "norm2: ", norm2
239  ! WRITE (*, *) "relative residual norm diff: ", rel_diff
240  ! CPABORT("residual norm diff")
241  !END IF
242  END SUBROUTINE validate
243 
244 #else
245 
246 ! **************************************************************************************************
247 !> \brief Dummy for when DBM_VALIDATE_AGAINST_DBCSR is not defined.
248 !> \param matrix ...
249 ! **************************************************************************************************
250  SUBROUTINE validate(matrix)
251  TYPE(dbm_type), INTENT(IN) :: matrix
252 
253  mark_used(matrix)
254  END SUBROUTINE validate
255 #endif
256 
257 ! **************************************************************************************************
258 !> \brief Creates a new matrix from given template, reusing dist and row/col_block_sizes.
259 !> \param matrix ...
260 !> \param name ...
261 !> \param template ...
262 !> \author Ole Schuett
263 ! **************************************************************************************************
264  SUBROUTINE dbm_create_from_template(matrix, name, template)
265  TYPE(dbm_type), INTENT(INOUT) :: matrix
266  CHARACTER(len=*), INTENT(IN) :: name
267  TYPE(dbm_type), INTENT(IN) :: template
268 
269  INTEGER, CONTIGUOUS, DIMENSION(:), POINTER :: col_block_sizes, row_block_sizes
270 
271  ! Store pointers in intermediate variables to workaround a CCE error.
272  row_block_sizes => dbm_get_row_block_sizes(template)
273  col_block_sizes => dbm_get_col_block_sizes(template)
274 
275  CALL dbm_create(matrix, &
276  name=name, &
277  dist=dbm_get_distribution(template), &
278  row_block_sizes=row_block_sizes, &
279  col_block_sizes=col_block_sizes)
280 
281  END SUBROUTINE dbm_create_from_template
282 
283 ! **************************************************************************************************
284 !> \brief Creates a new matrix.
285 !> \param matrix ...
286 !> \param name ...
287 !> \param dist ...
288 !> \param row_block_sizes ...
289 !> \param col_block_sizes ...
290 !> \author Ole Schuett
291 ! **************************************************************************************************
292  SUBROUTINE dbm_create(matrix, name, dist, row_block_sizes, col_block_sizes)
293  TYPE(dbm_type), INTENT(INOUT) :: matrix
294  CHARACTER(len=*), INTENT(IN) :: name
295  TYPE(dbm_distribution_obj), INTENT(IN) :: dist
296  INTEGER, CONTIGUOUS, DIMENSION(:), INTENT(IN), &
297  POINTER :: row_block_sizes, col_block_sizes
298 
299  INTERFACE
300  SUBROUTINE dbm_create_c(matrix, dist, name, nrows, ncols, row_sizes, col_sizes) &
301  BIND(C, name="dbm_create")
302  IMPORT :: c_ptr, c_char, c_int
303  TYPE(c_ptr) :: matrix
304  TYPE(c_ptr), VALUE :: dist
305  CHARACTER(kind=C_CHAR), DIMENSION(*) :: name
306  INTEGER(kind=C_INT), VALUE :: nrows
307  INTEGER(kind=C_INT), VALUE :: ncols
308  INTEGER(kind=C_INT), DIMENSION(*) :: row_sizes
309  INTEGER(kind=C_INT), DIMENSION(*) :: col_sizes
310  END SUBROUTINE dbm_create_c
311  END INTERFACE
312 
313  cpassert(.NOT. c_associated(matrix%c_ptr))
314  CALL dbm_create_c(matrix=matrix%c_ptr, &
315  dist=dist%c_ptr, &
316  name=trim(name)//c_null_char, &
317  nrows=SIZE(row_block_sizes), &
318  ncols=SIZE(col_block_sizes), &
319  row_sizes=row_block_sizes, &
320  col_sizes=col_block_sizes)
321  cpassert(c_associated(matrix%c_ptr))
322 
323 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
324  CALL dbcsr_create(matrix%dbcsr, name=name, dist=dist%dbcsr, &
325  matrix_type=dbcsr_type_no_symmetry, &
326  row_blk_size=row_block_sizes, col_blk_size=col_block_sizes, &
327  data_type=dbcsr_type_real_8)
328 
329  CALL validate(matrix)
330 #endif
331  END SUBROUTINE dbm_create
332 
333 ! **************************************************************************************************
334 !> \brief Needed to be called for DBCSR after blocks where inserted. For DBM it's a no-opt.
335 !> \param matrix ...
336 !> \author Ole Schuett
337 ! **************************************************************************************************
338  SUBROUTINE dbm_finalize(matrix)
339  TYPE(dbm_type), INTENT(INOUT) :: matrix
340 
341  mark_used(matrix) ! New implementation does not need finalize.
342 
343 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
344  CALL dbcsr_finalize(matrix%dbcsr)
345 #endif
346  END SUBROUTINE dbm_finalize
347 
348 ! **************************************************************************************************
349 !> \brief Releases a matrix and all its ressources.
350 !> \param matrix ...
351 !> \author Ole Schuett
352 ! **************************************************************************************************
353  SUBROUTINE dbm_release(matrix)
354  TYPE(dbm_type), INTENT(INOUT) :: matrix
355 
356  INTERFACE
357  SUBROUTINE dbm_release_c(matrix) &
358  BIND(C, name="dbm_release")
359  IMPORT :: c_ptr
360  TYPE(c_ptr), VALUE :: matrix
361  END SUBROUTINE dbm_release_c
362  END INTERFACE
363 
364  CALL dbm_release_c(matrix=matrix%c_ptr)
365  matrix%c_ptr = c_null_ptr
366 
367 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
368  CALL dbcsr_release(matrix%dbcsr)
369 #endif
370  END SUBROUTINE dbm_release
371 
372 ! **************************************************************************************************
373 !> \brief Copies content of matrix_b into matrix_a.
374 !> Matrices must have the same row/col block sizes and distribution.
375 !> \param matrix_a ...
376 !> \param matrix_b ...
377 !> \author Ole Schuett
378 ! **************************************************************************************************
379  SUBROUTINE dbm_copy(matrix_a, matrix_b)
380  TYPE(dbm_type), INTENT(INOUT) :: matrix_a
381  TYPE(dbm_type), INTENT(IN) :: matrix_b
382 
383  CHARACTER(LEN=*), PARAMETER :: routinen = 'dbm_copy'
384 
385  INTEGER :: handle
386  INTERFACE
387  SUBROUTINE dbm_copy_c(matrix_a, matrix_b) &
388  BIND(C, name="dbm_copy")
389  IMPORT :: c_ptr
390  TYPE(c_ptr), VALUE :: matrix_a
391  TYPE(c_ptr), VALUE :: matrix_b
392  END SUBROUTINE dbm_copy_c
393  END INTERFACE
394 
395  CALL timeset(routinen, handle)
396  CALL dbm_copy_c(matrix_a=matrix_a%c_ptr, matrix_b=matrix_b%c_ptr)
397 
398 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
399  CALL dbcsr_copy(matrix_a%dbcsr, matrix_b%dbcsr)
400  CALL validate(matrix_a)
401 #endif
402  CALL timestop(handle)
403  END SUBROUTINE dbm_copy
404 
405 ! **************************************************************************************************
406 !> \brief Copies content of matrix_b into matrix_a. Matrices may have different distributions.
407 !> \param matrix ...
408 !> \param redist ...
409 !> \author Ole Schuett
410 ! **************************************************************************************************
411  SUBROUTINE dbm_redistribute(matrix, redist)
412  TYPE(dbm_type), INTENT(IN) :: matrix
413  TYPE(dbm_type), INTENT(INOUT) :: redist
414 
415  CHARACTER(LEN=*), PARAMETER :: routinen = 'dbm_redistribute'
416 
417  INTEGER :: handle
418  INTERFACE
419  SUBROUTINE dbm_redistribute_c(matrix, redist) &
420  BIND(C, name="dbm_redistribute")
421  IMPORT :: c_ptr
422  TYPE(c_ptr), VALUE :: matrix
423  TYPE(c_ptr), VALUE :: redist
424  END SUBROUTINE dbm_redistribute_c
425  END INTERFACE
426 
427  CALL timeset(routinen, handle)
428  CALL dbm_redistribute_c(matrix=matrix%c_ptr, redist=redist%c_ptr)
429 
430 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
431  CALL dbcsr_redistribute(matrix%dbcsr, redist%dbcsr)
432  CALL validate(redist)
433 #endif
434  CALL timestop(handle)
435  END SUBROUTINE dbm_redistribute
436 
437 ! **************************************************************************************************
438 !> \brief Looks up a block from given matrics. This routine is thread-safe.
439 !> If the block is not found then a null pointer is returned.
440 !> \param matrix ...
441 !> \param row ...
442 !> \param col ...
443 !> \param block ...
444 !> \param row_size ...
445 !> \param col_size ...
446 !> \author Ole Schuett
447 ! **************************************************************************************************
448  SUBROUTINE dbm_get_block_p(matrix, row, col, block, row_size, col_size)
449  TYPE(dbm_type), INTENT(INOUT) :: matrix
450  INTEGER, INTENT(IN) :: row, col
451  REAL(dp), DIMENSION(:, :), INTENT(OUT), POINTER :: block
452  INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size
453 
454  INTEGER :: my_col_size, my_row_size
455  TYPE(c_ptr) :: block_c
456  INTERFACE
457  SUBROUTINE dbm_get_block_p_c(matrix, row, col, block, row_size, col_size) &
458  BIND(C, name="dbm_get_block_p")
459  IMPORT :: c_ptr, c_int
460  TYPE(c_ptr), VALUE :: matrix
461  INTEGER(kind=C_INT), VALUE :: row
462  INTEGER(kind=C_INT), VALUE :: col
463  TYPE(c_ptr) :: block
464  INTEGER(kind=C_INT) :: row_size
465  INTEGER(kind=C_INT) :: col_size
466  END SUBROUTINE dbm_get_block_p_c
467  END INTERFACE
468 
469  CALL dbm_get_block_p_c(matrix=matrix%c_ptr, row=row - 1, col=col - 1, &
470  block=block_c, row_size=my_row_size, col_size=my_col_size)
471  IF (c_associated(block_c)) THEN
472  CALL c_f_pointer(block_c, block, shape=(/my_row_size, my_col_size/))
473  ELSE
474  NULLIFY (block) ! block not found
475  END IF
476  IF (PRESENT(row_size)) row_size = my_row_size
477  IF (PRESENT(col_size)) col_size = my_col_size
478  END SUBROUTINE dbm_get_block_p
479 
480 ! **************************************************************************************************
481 !> \brief Adds a block to given matrix. This routine is thread-safe.
482 !> If block already exist then it gets overwritten (or summed).
483 !> \param matrix ...
484 !> \param row ...
485 !> \param col ...
486 !> \param block ...
487 !> \param summation ...
488 !> \author Ole Schuett
489 ! **************************************************************************************************
490  SUBROUTINE dbm_put_block(matrix, row, col, block, summation)
491  TYPE(dbm_type), INTENT(INOUT) :: matrix
492  INTEGER, INTENT(IN) :: row, col
493  REAL(dp), CONTIGUOUS, DIMENSION(:, :), INTENT(IN) :: block
494  LOGICAL, INTENT(IN), OPTIONAL :: summation
495 
496  LOGICAL :: my_summation
497  INTERFACE
498  SUBROUTINE dbm_put_block_c(matrix, row, col, summation, block) &
499  BIND(C, name="dbm_put_block")
500  IMPORT :: c_ptr, c_int, c_bool, c_double
501  TYPE(c_ptr), VALUE :: matrix
502  INTEGER(kind=C_INT), VALUE :: row
503  INTEGER(kind=C_INT), VALUE :: col
504  LOGICAL(kind=C_BOOL), VALUE :: summation
505  REAL(kind=c_double), DIMENSION(*) :: block
506  END SUBROUTINE dbm_put_block_c
507  END INTERFACE
508 
509  my_summation = .false.
510  IF (PRESENT(summation)) my_summation = summation
511 
512  CALL dbm_put_block_c(matrix=matrix%c_ptr, &
513  row=row - 1, col=col - 1, &
514  summation=LOGICAL(my_summation, C_BOOL), &
515  block=block)
516 
517 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
518  CALL dbcsr_put_block(matrix%dbcsr, row, col, block, summation=summation)
519  ! Can not call validate(matrix) because the dbcsr matrix needs to be finalized first.
520 #endif
521  END SUBROUTINE dbm_put_block
522 
523 ! **************************************************************************************************
524 !> \brief Remove all blocks from given matrix, but does not release the underlying memory.
525 !> \param matrix ...
526 !> \author Ole Schuett
527 ! **************************************************************************************************
528  SUBROUTINE dbm_clear(matrix)
529  TYPE(dbm_type), INTENT(INOUT) :: matrix
530 
531  INTERFACE
532  SUBROUTINE dbm_clear_c(matrix) &
533  BIND(C, name="dbm_clear")
534  IMPORT :: c_ptr
535  TYPE(c_ptr), VALUE :: matrix
536  END SUBROUTINE dbm_clear_c
537  END INTERFACE
538 
539  CALL dbm_clear_c(matrix=matrix%c_ptr)
540 
541 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
542  CALL dbcsr_clear(matrix%dbcsr)
543  CALL validate(matrix)
544 #endif
545  END SUBROUTINE dbm_clear
546 
547 ! **************************************************************************************************
548 !> \brief Removes all blocks from the given matrix whose block norm is below the given threshold.
549 !> Blocks of size zero are always kept.
550 !> \param matrix ...
551 !> \param eps ...
552 !> \author Ole Schuett
553 ! **************************************************************************************************
554  SUBROUTINE dbm_filter(matrix, eps)
555  TYPE(dbm_type), INTENT(INOUT) :: matrix
556  REAL(dp), INTENT(IN) :: eps
557 
558  CHARACTER(LEN=*), PARAMETER :: routinen = 'dbm_filter'
559 
560  INTEGER :: handle
561  INTERFACE
562  SUBROUTINE dbm_filter_c(matrix, eps) &
563  BIND(C, name="dbm_filter")
564  IMPORT :: c_ptr, c_double
565  TYPE(c_ptr), VALUE :: matrix
566  REAL(kind=c_double), VALUE :: eps
567  END SUBROUTINE dbm_filter_c
568  END INTERFACE
569 
570  CALL timeset(routinen, handle)
571  CALL validate(matrix)
572  CALL dbm_filter_c(matrix=matrix%c_ptr, eps=eps)
573 
574 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
575  CALL dbcsr_filter(matrix%dbcsr, eps)
576  CALL validate(matrix)
577 #endif
578  CALL timestop(handle)
579  END SUBROUTINE dbm_filter
580 
581 ! **************************************************************************************************
582 !> \brief Adds given list of blocks efficiently. The blocks will be filled with zeros.
583 !> \param matrix ...
584 !> \param rows ...
585 !> \param cols ...
586 !> \author Ole Schuett
587 ! **************************************************************************************************
588  SUBROUTINE dbm_reserve_blocks(matrix, rows, cols)
589  TYPE(dbm_type), INTENT(INOUT) :: matrix
590  INTEGER, DIMENSION(:), INTENT(IN) :: rows, cols
591 
592  CHARACTER(LEN=*), PARAMETER :: routinen = 'dbm_reserve_blocks'
593 
594  INTEGER :: handle
595  INTEGER(kind=C_INT), DIMENSION(SIZE(rows)) :: cols_c, rows_c
596  INTERFACE
597  SUBROUTINE dbm_reserve_blocks_c(matrix, nblocks, rows, cols) &
598  BIND(C, name="dbm_reserve_blocks")
599  IMPORT :: c_ptr, c_int
600  TYPE(c_ptr), VALUE :: matrix
601  INTEGER(kind=C_INT), VALUE :: nblocks
602  INTEGER(kind=C_INT), DIMENSION(*) :: rows
603  INTEGER(kind=C_INT), DIMENSION(*) :: cols
604  END SUBROUTINE dbm_reserve_blocks_c
605  END INTERFACE
606 
607  CALL timeset(routinen, handle)
608  cpassert(SIZE(rows) == SIZE(cols))
609  rows_c = rows - 1
610  cols_c = cols - 1
611 
612  CALL dbm_reserve_blocks_c(matrix=matrix%c_ptr, &
613  nblocks=SIZE(rows), &
614  rows=rows_c, &
615  cols=cols_c)
616 
617 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
618  CALL dbcsr_reserve_blocks(matrix%dbcsr, rows, cols)
619  CALL validate(matrix)
620 #endif
621  CALL timestop(handle)
622  END SUBROUTINE dbm_reserve_blocks
623 
624 ! **************************************************************************************************
625 !> \brief Multiplies all entries in the given matrix by the given factor alpha.
626 !> \param matrix ...
627 !> \param alpha ...
628 !> \author Ole Schuett
629 ! **************************************************************************************************
630  SUBROUTINE dbm_scale(matrix, alpha)
631  TYPE(dbm_type), INTENT(INOUT) :: matrix
632  REAL(dp), INTENT(IN) :: alpha
633 
634  CHARACTER(LEN=*), PARAMETER :: routinen = 'dbm_scale'
635 
636  INTEGER :: handle
637  INTERFACE
638  SUBROUTINE dbm_scale_c(matrix, alpha) &
639  BIND(C, name="dbm_scale")
640  IMPORT :: c_ptr, c_double
641  TYPE(c_ptr), VALUE :: matrix
642  REAL(kind=c_double), VALUE :: alpha
643  END SUBROUTINE dbm_scale_c
644  END INTERFACE
645 
646  CALL timeset(routinen, handle)
647  CALL dbm_scale_c(matrix=matrix%c_ptr, alpha=alpha)
648 
649 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
650  CALL dbcsr_scale(matrix%dbcsr, alpha)
651  CALL validate(matrix)
652 #endif
653  CALL timestop(handle)
654  END SUBROUTINE dbm_scale
655 
656 ! **************************************************************************************************
657 !> \brief Sets all blocks in the given matrix to zero.
658 !> \param matrix ...
659 !> \author Ole Schuett
660 ! **************************************************************************************************
661  SUBROUTINE dbm_zero(matrix)
662  TYPE(dbm_type), INTENT(INOUT) :: matrix
663 
664  CHARACTER(LEN=*), PARAMETER :: routinen = 'dbm_zero'
665 
666  INTEGER :: handle
667  INTERFACE
668  SUBROUTINE dbm_zero_c(matrix) &
669  BIND(C, name="dbm_zero")
670  IMPORT :: c_ptr
671  TYPE(c_ptr), VALUE :: matrix
672  END SUBROUTINE dbm_zero_c
673  END INTERFACE
674 
675  CALL timeset(routinen, handle)
676  CALL dbm_zero_c(matrix=matrix%c_ptr)
677 
678 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
679  CALL dbcsr_zero(matrix%dbcsr)
680  CALL validate(matrix)
681 #endif
682  CALL timestop(handle)
683  END SUBROUTINE dbm_zero
684 
685 ! **************************************************************************************************
686 !> \brief Adds matrix_b to matrix_a.
687 !> \param matrix_a ...
688 !> \param matrix_b ...
689 !> \author Ole Schuett
690 ! **************************************************************************************************
691  SUBROUTINE dbm_add(matrix_a, matrix_b)
692  TYPE(dbm_type), INTENT(INOUT) :: matrix_a
693  TYPE(dbm_type), INTENT(IN) :: matrix_b
694 
695  CHARACTER(LEN=*), PARAMETER :: routinen = 'dbm_add'
696 
697  INTEGER :: handle
698  INTERFACE
699  SUBROUTINE dbm_add_c(matrix_a, matrix_b) &
700  BIND(C, name="dbm_add")
701  IMPORT :: c_ptr, c_double
702  TYPE(c_ptr), VALUE :: matrix_a
703  TYPE(c_ptr), VALUE :: matrix_b
704  END SUBROUTINE dbm_add_c
705  END INTERFACE
706 
707  CALL timeset(routinen, handle)
708  CALL validate(matrix_a)
709  CALL validate(matrix_b)
710  CALL dbm_add_c(matrix_a=matrix_a%c_ptr, matrix_b=matrix_b%c_ptr)
711 
712 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
713  CALL dbcsr_add(matrix_a%dbcsr, matrix_b%dbcsr)
714  CALL validate(matrix_a)
715 #endif
716  CALL timestop(handle)
717  END SUBROUTINE dbm_add
718 
719 ! **************************************************************************************************
720 !> \brief Computes matrix product: matrix_c = alpha * matrix_a * matrix_b + beta * matrix_c.
721 !> \param transa ...
722 !> \param transb ...
723 !> \param alpha ...
724 !> \param matrix_a ...
725 !> \param matrix_b ...
726 !> \param beta ...
727 !> \param matrix_c ...
728 !> \param retain_sparsity ...
729 !> \param filter_eps ...
730 !> \param flop ...
731 !> \author Ole Schuett
732 ! **************************************************************************************************
733  SUBROUTINE dbm_multiply(transa, transb, &
734  alpha, matrix_a, matrix_b, beta, matrix_c, &
735  retain_sparsity, filter_eps, flop)
736  LOGICAL, INTENT(IN) :: transa, transb
737  REAL(kind=dp), INTENT(IN) :: alpha
738  TYPE(dbm_type), INTENT(IN) :: matrix_a, matrix_b
739  REAL(kind=dp), INTENT(IN) :: beta
740  TYPE(dbm_type), INTENT(INOUT) :: matrix_c
741  LOGICAL, INTENT(IN), OPTIONAL :: retain_sparsity
742  REAL(kind=dp), INTENT(IN), OPTIONAL :: filter_eps
743  INTEGER(int_8), INTENT(OUT), OPTIONAL :: flop
744 
745  CHARACTER(LEN=*), PARAMETER :: routinen = 'dbm_multiply'
746 
747  CHARACTER(LEN=1) :: transa_char, transb_char
748  INTEGER :: handle
749  INTEGER(int_8) :: flop_dbcsr, my_flop
750  LOGICAL :: my_retain_sparsity
751  REAL(kind=dp) :: my_filter_eps
752  INTERFACE
753  SUBROUTINE dbm_multiply_c(transa, transb, alpha, &
754  matrix_a, matrix_b, &
755  beta, matrix_c, &
756  retain_sparsity, filter_eps, flop) &
757  BIND(C, name="dbm_multiply")
758  IMPORT :: c_ptr, c_double, c_bool, c_int64_t
759  LOGICAL(kind=C_BOOL), VALUE :: transa
760  LOGICAL(kind=C_BOOL), VALUE :: transb
761  REAL(kind=c_double), VALUE :: alpha
762  TYPE(c_ptr), VALUE :: matrix_a
763  TYPE(c_ptr), VALUE :: matrix_b
764  REAL(kind=c_double), VALUE :: beta
765  TYPE(c_ptr), VALUE :: matrix_c
766  LOGICAL(kind=C_BOOL), VALUE :: retain_sparsity
767  REAL(kind=c_double), VALUE :: filter_eps
768  INTEGER(kind=C_INT64_T) :: flop
769  END SUBROUTINE dbm_multiply_c
770  END INTERFACE
771 
772  CALL timeset(routinen, handle)
773 
774  IF (PRESENT(retain_sparsity)) THEN
775  my_retain_sparsity = retain_sparsity
776  ELSE
777  my_retain_sparsity = .false.
778  END IF
779 
780  IF (PRESENT(filter_eps)) THEN
781  my_filter_eps = filter_eps
782  ELSE
783  my_filter_eps = 0.0_dp
784  END IF
785 
786  CALL validate(matrix_a)
787  CALL validate(matrix_b)
788  CALL validate(matrix_c)
789  CALL dbm_multiply_c(transa=LOGICAL(transa, C_BOOL), &
790  transb=logical(transb, c_bool), &
791  alpha=alpha, &
792  matrix_a=matrix_a%c_ptr, &
793  matrix_b=matrix_b%c_ptr, &
794  beta=beta, &
795  matrix_c=matrix_c%c_ptr, &
796  retain_sparsity=LOGICAL(my_retain_sparsity, C_BOOL), &
797  filter_eps=my_filter_eps, &
798  flop=my_flop)
799 
800  IF (PRESENT(flop)) THEN
801  flop = my_flop
802  END IF
803 
804 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
805  IF (transa) THEN
806  transa_char = dbcsr_transpose
807  ELSE
808  transa_char = dbcsr_no_transpose
809  END IF
810  IF (transb) THEN
811  transb_char = dbcsr_transpose
812  ELSE
813  transb_char = dbcsr_no_transpose
814  END IF
815  CALL dbcsr_multiply(transa=transa_char, transb=transb_char, &
816  alpha=alpha, matrix_a=matrix_a%dbcsr, &
817  matrix_b=matrix_b%dbcsr, beta=beta, matrix_c=matrix_c%dbcsr, &
818  retain_sparsity=retain_sparsity, filter_eps=filter_eps, flop=flop_dbcsr)
819  cpassert(my_flop == flop_dbcsr)
820  CALL validate(matrix_c)
821 #else
822  ! Can not use preprocessor's ifdefs before INTERFACE because it confuses prettify.
823  mark_used(transa_char)
824  mark_used(transb_char)
825  mark_used(flop_dbcsr)
826 #endif
827  CALL timestop(handle)
828  END SUBROUTINE dbm_multiply
829 
830 ! **************************************************************************************************
831 !> \brief Creates an iterator for the blocks of the given matrix. The iteration order is not stable.
832 !> \param iterator ...
833 !> \param matrix ...
834 !> \author Ole Schuett
835 ! **************************************************************************************************
836  SUBROUTINE dbm_iterator_start(iterator, matrix)
837  TYPE(dbm_iterator), INTENT(OUT) :: iterator
838  TYPE(dbm_type), INTENT(IN) :: matrix
839 
840  INTERFACE
841  SUBROUTINE dbm_iterator_start_c(iterator, matrix) &
842  BIND(C, name="dbm_iterator_start")
843  IMPORT :: c_ptr
844  TYPE(c_ptr) :: iterator
845  TYPE(c_ptr), VALUE :: matrix
846  END SUBROUTINE dbm_iterator_start_c
847  END INTERFACE
848 
849  cpassert(.NOT. c_associated(iterator%c_ptr))
850  CALL dbm_iterator_start_c(iterator=iterator%c_ptr, matrix=matrix%c_ptr)
851  cpassert(c_associated(iterator%c_ptr))
852  CALL validate(matrix)
853  END SUBROUTINE dbm_iterator_start
854 
855 ! **************************************************************************************************
856 !> \brief Returns number of blocks the iterator will provide to calling thread.
857 !> \param iterator ...
858 !> \return ...
859 !> \author Ole Schuett
860 ! **************************************************************************************************
861  FUNCTION dbm_iterator_num_blocks(iterator) RESULT(num_blocks)
862  TYPE(dbm_iterator), INTENT(IN) :: iterator
863  INTEGER :: num_blocks
864 
865  INTERFACE
866  FUNCTION dbm_iterator_num_blocks_c(iterator) &
867  BIND(C, name="dbm_iterator_num_blocks")
868  IMPORT :: c_ptr, c_int
869  TYPE(c_ptr), VALUE :: iterator
870  INTEGER(kind=C_INT) :: dbm_iterator_num_blocks_c
871  END FUNCTION dbm_iterator_num_blocks_c
872  END INTERFACE
873 
874  num_blocks = dbm_iterator_num_blocks_c(iterator%c_ptr)
875  END FUNCTION dbm_iterator_num_blocks
876 
877 ! **************************************************************************************************
878 !> \brief Tests whether the given iterator has any block left.
879 !> \param iterator ...
880 !> \return ...
881 !> \author Ole Schuett
882 ! **************************************************************************************************
883  FUNCTION dbm_iterator_blocks_left(iterator) RESULT(blocks_left)
884  TYPE(dbm_iterator), INTENT(IN) :: iterator
885  LOGICAL :: blocks_left
886 
887  INTERFACE
888  FUNCTION dbm_iterator_blocks_left_c(iterator) &
889  BIND(C, name="dbm_iterator_blocks_left")
890  IMPORT :: c_ptr, c_bool
891  TYPE(c_ptr), VALUE :: iterator
892  LOGICAL(C_BOOL) :: dbm_iterator_blocks_left_c
893  END FUNCTION dbm_iterator_blocks_left_c
894  END INTERFACE
895 
896  blocks_left = dbm_iterator_blocks_left_c(iterator%c_ptr)
897  END FUNCTION dbm_iterator_blocks_left
898 
899 ! **************************************************************************************************
900 !> \brief Returns the next block from the given iterator.
901 !> \param iterator ...
902 !> \param row ...
903 !> \param column ...
904 !> \param block ...
905 !> \param row_size ...
906 !> \param col_size ...
907 !> \author Ole Schuett
908 ! **************************************************************************************************
909  SUBROUTINE dbm_iterator_next_block(iterator, row, column, block, row_size, col_size)
910  TYPE(dbm_iterator), INTENT(INOUT) :: iterator
911  INTEGER, INTENT(OUT) :: row, column
912  REAL(dp), DIMENSION(:, :), INTENT(OUT), OPTIONAL, &
913  POINTER :: block
914  INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size
915 
916  INTEGER :: col0, my_col_size, my_row_size, row0
917  TYPE(c_ptr) :: block_c
918  INTERFACE
919  SUBROUTINE dbm_iterator_next_block_c(iterator, row, col, block, row_size, col_size) &
920  BIND(C, name="dbm_iterator_next_block")
921  IMPORT :: c_ptr, c_int
922  TYPE(c_ptr), VALUE :: iterator
923  INTEGER(kind=C_INT) :: row
924  INTEGER(kind=C_INT) :: col
925  TYPE(c_ptr) :: block
926  INTEGER(kind=C_INT) :: row_size
927  INTEGER(kind=C_INT) :: col_size
928  END SUBROUTINE dbm_iterator_next_block_c
929  END INTERFACE
930 
931  CALL dbm_iterator_next_block_c(iterator%c_ptr, row=row0, col=col0, block=block_c, &
932  row_size=my_row_size, col_size=my_col_size)
933 
934  cpassert(c_associated(block_c))
935  IF (PRESENT(block)) CALL c_f_pointer(block_c, block, shape=(/my_row_size, my_col_size/))
936  row = row0 + 1
937  column = col0 + 1
938  IF (PRESENT(row_size)) row_size = my_row_size
939  IF (PRESENT(col_size)) col_size = my_col_size
940  END SUBROUTINE dbm_iterator_next_block
941 
942 ! **************************************************************************************************
943 !> \brief Releases the given iterator.
944 !> \param iterator ...
945 !> \author Ole Schuett
946 ! **************************************************************************************************
947  SUBROUTINE dbm_iterator_stop(iterator)
948  TYPE(dbm_iterator), INTENT(INOUT) :: iterator
949 
950  INTERFACE
951  SUBROUTINE dbm_iterator_stop_c(iterator) &
952  BIND(C, name="dbm_iterator_stop")
953  IMPORT :: c_ptr
954  TYPE(c_ptr), VALUE :: iterator
955  END SUBROUTINE dbm_iterator_stop_c
956  END INTERFACE
957 
958  CALL dbm_iterator_stop_c(iterator%c_ptr)
959  iterator%c_ptr = c_null_ptr
960  END SUBROUTINE dbm_iterator_stop
961 
962 ! **************************************************************************************************
963 !> \brief Computes a checksum of the given matrix.
964 !> \param matrix ...
965 !> \return ...
966 !> \author Ole Schuett
967 ! **************************************************************************************************
968  FUNCTION dbm_checksum(matrix) RESULT(res)
969  TYPE(dbm_type), INTENT(IN) :: matrix
970  REAL(kind=dp) :: res
971 
972  INTERFACE
973  FUNCTION dbm_checksum_c(matrix) &
974  BIND(C, name="dbm_checksum")
975  IMPORT :: c_ptr, c_double
976  TYPE(c_ptr), VALUE :: matrix
977  REAL(c_double) :: dbm_checksum_c
978  END FUNCTION dbm_checksum_c
979  END INTERFACE
980 
981  CALL validate(matrix)
982  res = dbm_checksum_c(matrix%c_ptr)
983 
984 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
985  cpassert(abs(res - dbcsr_checksum(matrix%dbcsr))/max(1.0_dp, abs(res)) < dbm_validate_threshold)
986 #endif
987  END FUNCTION dbm_checksum
988 
989 ! **************************************************************************************************
990 !> \brief Returns the absolute value of the larges element of the entire given matrix.
991 !> \param matrix ...
992 !> \return ...
993 !> \author Ole Schuett
994 ! **************************************************************************************************
995  FUNCTION dbm_maxabs(matrix) RESULT(res)
996  TYPE(dbm_type), INTENT(INOUT) :: matrix
997  REAL(kind=dp) :: res
998 
999  INTERFACE
1000  FUNCTION dbm_maxabs_c(matrix) &
1001  BIND(C, name="dbm_maxabs")
1002  IMPORT :: c_ptr, c_double
1003  TYPE(c_ptr), VALUE :: matrix
1004  REAL(c_double) :: dbm_maxabs_c
1005  END FUNCTION dbm_maxabs_c
1006  END INTERFACE
1007 
1008  CALL validate(matrix)
1009  res = dbm_maxabs_c(matrix%c_ptr)
1010 
1011 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
1012  cpassert(abs(res - dbcsr_maxabs(matrix%dbcsr))/max(1.0_dp, abs(res)) < dbm_validate_threshold)
1013 #endif
1014  END FUNCTION dbm_maxabs
1015 
1016 ! **************************************************************************************************
1017 !> \brief Returns the name of the matrix of the given matrix.
1018 !> \param matrix ...
1019 !> \return ...
1020 !> \author Ole Schuett
1021 ! **************************************************************************************************
1022  FUNCTION dbm_get_name(matrix) RESULT(res)
1023  TYPE(dbm_type), INTENT(IN) :: matrix
1024  CHARACTER(len=default_string_length) :: res
1025 
1026  CHARACTER(LEN=1, KIND=C_CHAR), DIMENSION(:), &
1027  POINTER :: name_f
1028  INTEGER :: i
1029  TYPE(c_ptr) :: name_c
1030  INTERFACE
1031  FUNCTION dbm_get_name_c(matrix) BIND(C, name="dbm_get_name")
1032  IMPORT :: c_ptr
1033  TYPE(c_ptr), VALUE :: matrix
1034  TYPE(c_ptr) :: dbm_get_name_c
1035  END FUNCTION dbm_get_name_c
1036  END INTERFACE
1037 
1038  name_c = dbm_get_name_c(matrix%c_ptr)
1039 
1040  CALL c_f_pointer(name_c, name_f, shape=(/default_string_length/))
1041 
1042  res = ""
1043  DO i = 1, default_string_length
1044  IF (name_f(i) == c_null_char) EXIT
1045  res(i:i) = name_f(i)
1046  END DO
1047 
1048  END FUNCTION dbm_get_name
1049 
1050 ! **************************************************************************************************
1051 !> \brief Returns the number of local Non-Zero Elements of the given matrix.
1052 !> \param matrix ...
1053 !> \return ...
1054 !> \author Ole Schuett
1055 ! **************************************************************************************************
1056  PURE FUNCTION dbm_get_nze(matrix) RESULT(res)
1057  TYPE(dbm_type), INTENT(IN) :: matrix
1058  INTEGER :: res
1059 
1060  INTERFACE
1061  PURE FUNCTION dbm_get_nze_c(matrix) &
1062  BIND(C, name="dbm_get_nze")
1063  IMPORT :: c_ptr, c_int
1064  TYPE(c_ptr), VALUE, INTENT(IN) :: matrix
1065  INTEGER(C_INT) :: dbm_get_nze_c
1066  END FUNCTION dbm_get_nze_c
1067  END INTERFACE
1068 
1069  res = dbm_get_nze_c(matrix%c_ptr)
1070 
1071  END FUNCTION dbm_get_nze
1072 
1073 ! **************************************************************************************************
1074 !> \brief Returns the number of local blocks of the given matrix.
1075 !> \param matrix ...
1076 !> \return ...
1077 !> \author Ole Schuett
1078 ! **************************************************************************************************
1079  PURE FUNCTION dbm_get_num_blocks(matrix) RESULT(res)
1080  TYPE(dbm_type), INTENT(IN) :: matrix
1081  INTEGER :: res
1082 
1083  INTERFACE
1084  PURE FUNCTION dbm_get_num_blocks_c(matrix) &
1085  BIND(C, name="dbm_get_num_blocks")
1086  IMPORT :: c_ptr, c_int
1087  TYPE(c_ptr), VALUE, INTENT(IN) :: matrix
1088  INTEGER(C_INT) :: dbm_get_num_blocks_c
1089  END FUNCTION dbm_get_num_blocks_c
1090  END INTERFACE
1091 
1092  res = dbm_get_num_blocks_c(matrix%c_ptr)
1093 
1094  END FUNCTION dbm_get_num_blocks
1095 
1096 ! **************************************************************************************************
1097 !> \brief Returns the row block sizes of the given matrix.
1098 !> \param matrix ...
1099 !> \return ...
1100 !> \author Ole Schuett
1101 ! **************************************************************************************************
1102  FUNCTION dbm_get_row_block_sizes(matrix) RESULT(res)
1103  TYPE(dbm_type), INTENT(IN) :: matrix
1104  INTEGER, CONTIGUOUS, DIMENSION(:), POINTER :: res
1105 
1106  INTEGER :: nrows
1107  TYPE(c_ptr) :: row_sizes
1108  INTERFACE
1109  SUBROUTINE dbm_get_row_sizes_c(matrix, nrows, row_sizes) &
1110  BIND(C, name="dbm_get_row_sizes")
1111  IMPORT :: c_ptr, c_int
1112  TYPE(c_ptr), VALUE :: matrix
1113  INTEGER(C_INT) :: nrows
1114  TYPE(c_ptr) :: row_sizes
1115  END SUBROUTINE dbm_get_row_sizes_c
1116  END INTERFACE
1117 
1118  CALL dbm_get_row_sizes_c(matrix%c_ptr, nrows, row_sizes)
1119  CALL c_f_pointer(row_sizes, res, shape=(/nrows/))
1120  ! TODO: maybe return an ALLOCATABLE
1121  END FUNCTION dbm_get_row_block_sizes
1122 
1123 ! **************************************************************************************************
1124 !> \brief Returns the column block sizes of the given matrix.
1125 !> \param matrix ...
1126 !> \return ...
1127 !> \author Ole Schuett
1128 ! **************************************************************************************************
1129  FUNCTION dbm_get_col_block_sizes(matrix) RESULT(res)
1130  TYPE(dbm_type), INTENT(IN) :: matrix
1131  INTEGER, CONTIGUOUS, DIMENSION(:), POINTER :: res
1132 
1133  INTEGER :: ncols
1134  TYPE(c_ptr) :: col_sizes
1135  INTERFACE
1136  SUBROUTINE dbm_get_col_sizes_c(matrix, ncols, col_sizes) &
1137  BIND(C, name="dbm_get_col_sizes")
1138  IMPORT :: c_ptr, c_int
1139  TYPE(c_ptr), VALUE :: matrix
1140  INTEGER(C_INT) :: ncols
1141  TYPE(c_ptr) :: col_sizes
1142  END SUBROUTINE dbm_get_col_sizes_c
1143  END INTERFACE
1144 
1145  CALL dbm_get_col_sizes_c(matrix%c_ptr, ncols, col_sizes)
1146  CALL c_f_pointer(col_sizes, res, shape=(/ncols/))
1147  ! TODO: maybe return an ALLOCATABLE
1148  END FUNCTION dbm_get_col_block_sizes
1149 
1150 ! **************************************************************************************************
1151 !> \brief Returns the local row block sizes of the given matrix.
1152 !> \param matrix ...
1153 !> \param local_rows ...
1154 !> \return ...
1155 !> \author Ole Schuett
1156 ! **************************************************************************************************
1157  SUBROUTINE dbm_get_local_rows(matrix, local_rows)
1158  TYPE(dbm_type), INTENT(IN) :: matrix
1159  INTEGER, ALLOCATABLE, DIMENSION(:) :: local_rows
1160 
1161  INTEGER :: nlocal_rows
1162  INTEGER, DIMENSION(:), POINTER :: local_rows_dbcsr, local_rows_ptr
1163  TYPE(c_ptr) :: local_rows_c
1164  INTERFACE
1165  SUBROUTINE dbm_get_local_rows_c(matrix, nlocal_rows, local_rows) &
1166  BIND(C, name="dbm_get_local_rows")
1167  IMPORT :: c_ptr, c_int
1168  TYPE(c_ptr), VALUE :: matrix
1169  INTEGER(C_INT) :: nlocal_rows
1170  TYPE(c_ptr) :: local_rows
1171  END SUBROUTINE dbm_get_local_rows_c
1172  END INTERFACE
1173 
1174  CALL dbm_get_local_rows_c(matrix%c_ptr, nlocal_rows, local_rows_c)
1175  CALL c_f_pointer(local_rows_c, local_rows_ptr, shape=(/nlocal_rows/))
1176  ALLOCATE (local_rows(nlocal_rows))
1177  local_rows(:) = local_rows_ptr(:) + 1
1178 
1179 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
1180  CALL dbcsr_get_info(matrix%dbcsr, local_rows=local_rows_dbcsr)
1181  cpassert(all(local_rows == local_rows_dbcsr))
1182 #else
1183  mark_used(local_rows_dbcsr)
1184 #endif
1185  END SUBROUTINE dbm_get_local_rows
1186 
1187 ! **************************************************************************************************
1188 !> \brief Returns the local column block sizes of the given matrix.
1189 !> \param matrix ...
1190 !> \param local_cols ...
1191 !> \return ...
1192 !> \author Ole Schuett
1193 ! **************************************************************************************************
1194  SUBROUTINE dbm_get_local_cols(matrix, local_cols)
1195  TYPE(dbm_type), INTENT(IN) :: matrix
1196  INTEGER, ALLOCATABLE, DIMENSION(:) :: local_cols
1197 
1198  INTEGER :: nlocal_cols
1199  INTEGER, DIMENSION(:), POINTER :: local_cols_dbcsr, local_cols_ptr
1200  TYPE(c_ptr) :: local_cols_c
1201  INTERFACE
1202  SUBROUTINE dbm_get_local_cols_c(matrix, nlocal_cols, local_cols) &
1203  BIND(C, name="dbm_get_local_cols")
1204  IMPORT :: c_ptr, c_int
1205  TYPE(c_ptr), VALUE :: matrix
1206  INTEGER(C_INT) :: nlocal_cols
1207  TYPE(c_ptr) :: local_cols
1208  END SUBROUTINE dbm_get_local_cols_c
1209  END INTERFACE
1210 
1211  CALL dbm_get_local_cols_c(matrix%c_ptr, nlocal_cols, local_cols_c)
1212  CALL c_f_pointer(local_cols_c, local_cols_ptr, shape=(/nlocal_cols/))
1213  ALLOCATE (local_cols(nlocal_cols))
1214  local_cols(:) = local_cols_ptr(:) + 1
1215 
1216 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
1217  CALL dbcsr_get_info(matrix%dbcsr, local_cols=local_cols_dbcsr)
1218  cpassert(all(local_cols == local_cols_dbcsr))
1219 #else
1220  mark_used(local_cols_dbcsr)
1221 #endif
1222  END SUBROUTINE dbm_get_local_cols
1223 
1224 ! **************************************************************************************************
1225 !> \brief Returns the MPI rank on which the given block should be stored.
1226 !> \param matrix ...
1227 !> \param row ...
1228 !> \param column ...
1229 !> \param processor ...
1230 !> \author Ole Schuett
1231 ! **************************************************************************************************
1232  SUBROUTINE dbm_get_stored_coordinates(matrix, row, column, processor)
1233  TYPE(dbm_type), INTENT(IN) :: matrix
1234  INTEGER, INTENT(IN) :: row, column
1235  INTEGER, INTENT(OUT) :: processor
1236 
1237  INTEGER :: processor_dbcsr
1238  INTERFACE
1239  PURE FUNCTION dbm_get_stored_coordinates_c(matrix, row, col) &
1240  BIND(C, name="dbm_get_stored_coordinates")
1241  IMPORT :: c_ptr, c_int
1242  TYPE(c_ptr), VALUE, INTENT(IN) :: matrix
1243  INTEGER(C_INT), VALUE, INTENT(IN) :: row
1244  INTEGER(C_INT), VALUE, INTENT(IN) :: col
1245  INTEGER(C_INT) :: dbm_get_stored_coordinates_c
1246  END FUNCTION dbm_get_stored_coordinates_c
1247  END INTERFACE
1248 
1249  processor = dbm_get_stored_coordinates_c(matrix%c_ptr, row=row - 1, col=column - 1)
1250 
1251 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
1252  CALL dbcsr_get_stored_coordinates(matrix%dbcsr, row, column, processor_dbcsr)
1253  cpassert(processor == processor_dbcsr)
1254 #else
1255  mark_used(processor_dbcsr)
1256 #endif
1257  END SUBROUTINE dbm_get_stored_coordinates
1258 
1259 ! **************************************************************************************************
1260 !> \brief Returns the distribution of the given matrix.
1261 !> \param matrix ...
1262 !> \return ...
1263 !> \author Ole Schuett
1264 ! **************************************************************************************************
1265  FUNCTION dbm_get_distribution(matrix) RESULT(res)
1266  TYPE(dbm_type), INTENT(IN) :: matrix
1267  TYPE(dbm_distribution_obj) :: res
1268 
1269  INTERFACE
1270  FUNCTION dbm_get_distribution_c(matrix) BIND(C, name="dbm_get_distribution")
1271  IMPORT :: c_ptr
1272  TYPE(c_ptr), VALUE :: matrix
1273  TYPE(c_ptr) :: dbm_get_distribution_c
1274  END FUNCTION dbm_get_distribution_c
1275  END INTERFACE
1276 
1277  res%c_ptr = dbm_get_distribution_c(matrix%c_ptr)
1278 
1279 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
1280  CALL dbcsr_get_info(matrix%dbcsr, distribution=res%dbcsr)
1281 #endif
1282 
1283  END FUNCTION dbm_get_distribution
1284 
1285 ! **************************************************************************************************
1286 !> \brief Creates a new two dimensional distribution.
1287 !> \param dist ...
1288 !> \param mp_comm ...
1289 !> \param row_dist_block ...
1290 !> \param col_dist_block ...
1291 !> \author Ole Schuett
1292 ! **************************************************************************************************
1293  SUBROUTINE dbm_distribution_new(dist, mp_comm, row_dist_block, col_dist_block)
1294  TYPE(dbm_distribution_obj), INTENT(OUT) :: dist
1295 
1296  CLASS(mp_comm_type), INTENT(IN) :: mp_comm
1297  INTEGER, CONTIGUOUS, DIMENSION(:), INTENT(IN), &
1298  POINTER :: row_dist_block, col_dist_block
1299 
1300  INTERFACE
1301  SUBROUTINE dbm_distribution_new_c(dist, fortran_comm, nrows, ncols, row_dist, col_dist) &
1302  BIND(C, name="dbm_distribution_new")
1303  IMPORT :: c_ptr, c_char, c_int
1304  TYPE(c_ptr) :: dist
1305  INTEGER(kind=C_INT), VALUE :: fortran_comm
1306  INTEGER(kind=C_INT), VALUE :: nrows
1307  INTEGER(kind=C_INT), VALUE :: ncols
1308  INTEGER(kind=C_INT), DIMENSION(*) :: row_dist
1309  INTEGER(kind=C_INT), DIMENSION(*) :: col_dist
1310  END SUBROUTINE dbm_distribution_new_c
1311  END INTERFACE
1312 
1313  cpassert(.NOT. c_associated(dist%c_ptr))
1314  CALL dbm_distribution_new_c(dist=dist%c_ptr, &
1315  fortran_comm=mp_comm%get_handle(), &
1316  nrows=SIZE(row_dist_block), &
1317  ncols=SIZE(col_dist_block), &
1318  row_dist=row_dist_block, &
1319  col_dist=col_dist_block)
1320  cpassert(c_associated(dist%c_ptr))
1321 
1322 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
1323  CALL dbcsr_distribution_new_wrapper(dist, mp_comm, row_dist_block, col_dist_block)
1324 #endif
1325  END SUBROUTINE dbm_distribution_new
1326 
1327 ! **************************************************************************************************
1328 !> \brief Helper for creating a new DBCSR distribution. Only needed for DBM_VALIDATE_AGAINST_DBCSR.
1329 !> \param dist ...
1330 !> \param mp_comm ...
1331 !> \param row_dist_block ...
1332 !> \param col_dist_block ...
1333 !> \author Ole Schuett
1334 ! **************************************************************************************************
1335  SUBROUTINE dbcsr_distribution_new_wrapper(dist, mp_comm, row_dist_block, col_dist_block)
1336  TYPE(dbm_distribution_obj), INTENT(INOUT) :: dist
1337  TYPE(mp_cart_type), INTENT(IN) :: mp_comm
1338  INTEGER, CONTIGUOUS, DIMENSION(:), INTENT(IN), &
1339  POINTER :: row_dist_block, col_dist_block
1340 
1341 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
1342  INTEGER :: mynode, numnodes, pcol, prow
1343  INTEGER, ALLOCATABLE, DIMENSION(:, :) :: pgrid
1344  INTEGER, DIMENSION(2) :: coord, mycoord, npdims
1345  TYPE(dbcsr_mp_obj) :: mp_env
1346 
1347  ! Create a dbcsr mp environment from communicator
1348  CALL mp_comm%get_info_cart(npdims, mycoord)
1349  CALL mp_comm%get_size(numnodes)
1350  CALL mp_comm%get_rank(mynode)
1351  ALLOCATE (pgrid(0:npdims(1) - 1, 0:npdims(2) - 1))
1352  DO prow = 0, npdims(1) - 1
1353  DO pcol = 0, npdims(2) - 1
1354  coord = (/prow, pcol/)
1355  CALL mp_comm%rank_cart(coord, pgrid(prow, pcol))
1356  END DO
1357  END DO
1358  cpassert(mynode == pgrid(mycoord(1), mycoord(2)))
1359 
1360  CALL dbcsr_mp_new(mp_env, mp_comm%get_handle(), pgrid, mynode, numnodes, mycoord(1), mycoord(2))
1361  CALL dbcsr_distribution_new(dist=dist%dbcsr, mp_env=mp_env, &
1362  row_dist_block=row_dist_block, col_dist_block=col_dist_block)
1363  CALL dbcsr_mp_release(mp_env)
1364 #else
1365  mark_used(dist)
1366  mark_used(mp_comm)
1367  mark_used(row_dist_block)
1368  mark_used(col_dist_block)
1369 #endif
1370  END SUBROUTINE dbcsr_distribution_new_wrapper
1371 
1372 ! **************************************************************************************************
1373 !> \brief Increases the reference counter of the given distribution.
1374 !> \param dist ...
1375 !> \author Ole Schuett
1376 ! **************************************************************************************************
1377  SUBROUTINE dbm_distribution_hold(dist)
1378  TYPE(dbm_distribution_obj) :: dist
1379 
1380  INTERFACE
1381  SUBROUTINE dbm_distribution_hold_c(dist) &
1382  BIND(C, name="dbm_distribution_hold")
1383  IMPORT :: c_ptr
1384  TYPE(c_ptr), VALUE :: dist
1385  END SUBROUTINE dbm_distribution_hold_c
1386  END INTERFACE
1387 
1388  CALL dbm_distribution_hold_c(dist%c_ptr)
1389 
1390 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
1391  CALL dbcsr_distribution_hold(dist%dbcsr)
1392 #endif
1393  END SUBROUTINE dbm_distribution_hold
1394 
1395 ! **************************************************************************************************
1396 !> \brief Decreases the reference counter of the given distribution.
1397 !> \param dist ...
1398 !> \author Ole Schuett
1399 ! **************************************************************************************************
1400  SUBROUTINE dbm_distribution_release(dist)
1401  TYPE(dbm_distribution_obj) :: dist
1402 
1403  INTERFACE
1404  SUBROUTINE dbm_distribution_release_c(dist) &
1405  BIND(C, name="dbm_distribution_release")
1406  IMPORT :: c_ptr
1407  TYPE(c_ptr), VALUE :: dist
1408  END SUBROUTINE dbm_distribution_release_c
1409  END INTERFACE
1410 
1411  CALL dbm_distribution_release_c(dist%c_ptr)
1412 
1413 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
1414  CALL dbcsr_distribution_release(dist%dbcsr)
1415 #endif
1416  END SUBROUTINE dbm_distribution_release
1417 
1418 ! **************************************************************************************************
1419 !> \brief Returns the rows of the given distribution.
1420 !> \param dist ...
1421 !> \return ...
1422 !> \author Ole Schuett
1423 ! **************************************************************************************************
1424  FUNCTION dbm_distribution_row_dist(dist) RESULT(res)
1425  TYPE(dbm_distribution_obj), INTENT(IN) :: dist
1426  INTEGER, CONTIGUOUS, DIMENSION(:), POINTER :: res
1427 
1428  INTEGER :: nrows
1429  TYPE(c_ptr) :: row_dist
1430  INTERFACE
1431  SUBROUTINE dbm_distribution_row_dist_c(dist, nrows, row_dist) &
1432  BIND(C, name="dbm_distribution_row_dist")
1433  IMPORT :: c_ptr, c_int
1434  TYPE(c_ptr), VALUE :: dist
1435  INTEGER(C_INT) :: nrows
1436  TYPE(c_ptr) :: row_dist
1437  END SUBROUTINE dbm_distribution_row_dist_c
1438  END INTERFACE
1439 
1440  CALL dbm_distribution_row_dist_c(dist%c_ptr, nrows, row_dist)
1441  CALL c_f_pointer(row_dist, res, shape=(/nrows/))
1442 
1443 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
1444  cpassert(all(res == dbcsr_distribution_row_dist(dist%dbcsr)))
1445 #endif
1446  END FUNCTION dbm_distribution_row_dist
1447 
1448 ! **************************************************************************************************
1449 !> \brief Returns the columns of the given distribution.
1450 !> \param dist ...
1451 !> \return ...
1452 !> \author Ole Schuett
1453 ! **************************************************************************************************
1454  FUNCTION dbm_distribution_col_dist(dist) RESULT(res)
1455  TYPE(dbm_distribution_obj), INTENT(IN) :: dist
1456  INTEGER, CONTIGUOUS, DIMENSION(:), POINTER :: res
1457 
1458  INTEGER :: ncols
1459  TYPE(c_ptr) :: col_dist
1460  INTERFACE
1461  SUBROUTINE dbm_distribution_col_dist_c(dist, ncols, col_dist) &
1462  BIND(C, name="dbm_distribution_col_dist")
1463  IMPORT :: c_ptr, c_int
1464  TYPE(c_ptr), VALUE :: dist
1465  INTEGER(C_INT) :: ncols
1466  TYPE(c_ptr) :: col_dist
1467  END SUBROUTINE dbm_distribution_col_dist_c
1468  END INTERFACE
1469 
1470  CALL dbm_distribution_col_dist_c(dist%c_ptr, ncols, col_dist)
1471  CALL c_f_pointer(col_dist, res, shape=(/ncols/))
1472 
1473 #if defined(DBM_VALIDATE_AGAINST_DBCSR)
1474  cpassert(all(res == dbcsr_distribution_col_dist(dist%dbcsr)))
1475 #endif
1476  END FUNCTION dbm_distribution_col_dist
1477 
1478 ! **************************************************************************************************
1479 !> \brief Initialize DBM library
1480 !> \author Ole Schuett
1481 ! **************************************************************************************************
1482  SUBROUTINE dbm_library_init()
1483  INTERFACE
1484  SUBROUTINE dbm_library_init_c() BIND(C, name="dbm_library_init")
1485  END SUBROUTINE dbm_library_init_c
1486  END INTERFACE
1487 
1488  CALL dbm_library_init_c()
1489 
1490  END SUBROUTINE dbm_library_init
1491 
1492 ! **************************************************************************************************
1493 !> \brief Finalize DBM library
1494 !> \author Ole Schuett
1495 ! **************************************************************************************************
1496  SUBROUTINE dbm_library_finalize()
1497  INTERFACE
1498  SUBROUTINE dbm_library_finalize_c() BIND(C, name="dbm_library_finalize")
1499  END SUBROUTINE dbm_library_finalize_c
1500  END INTERFACE
1501 
1502  CALL dbm_library_finalize_c()
1503 
1504  END SUBROUTINE dbm_library_finalize
1505 
1506 ! **************************************************************************************************
1507 !> \brief Print DBM library statistics
1508 !> \param mpi_comm ...
1509 !> \param output_unit ...
1510 !> \author Ole Schuett
1511 ! **************************************************************************************************
1512  SUBROUTINE dbm_library_print_stats(mpi_comm, output_unit)
1513  TYPE(mp_comm_type), INTENT(IN) :: mpi_comm
1514  INTEGER, INTENT(IN) :: output_unit
1515 
1516  INTERFACE
1517  SUBROUTINE dbm_library_print_stats_c(mpi_comm, print_func, output_unit) &
1518  BIND(C, name="dbm_library_print_stats")
1519  IMPORT :: c_funptr, c_int
1520  INTEGER(KIND=C_INT), VALUE :: mpi_comm
1521  TYPE(c_funptr), VALUE :: print_func
1522  INTEGER(KIND=C_INT), VALUE :: output_unit
1523  END SUBROUTINE dbm_library_print_stats_c
1524  END INTERFACE
1525 
1526  ! Since Fortran units groups can't be used from C, we pass a function pointer instead.
1527  CALL dbm_library_print_stats_c(mpi_comm=mpi_comm%get_handle(), &
1528  print_func=c_funloc(print_func), &
1529  output_unit=output_unit)
1530 
1531  END SUBROUTINE dbm_library_print_stats
1532 
1533 ! **************************************************************************************************
1534 !> \brief Callback to write to a Fortran output unit.
1535 !> \param message ...
1536 !> \param output_unit ...
1537 !> \author Ole Schuett
1538 ! **************************************************************************************************
1539  SUBROUTINE print_func(message, output_unit) BIND(C, name="dbm_api_print_func")
1540  CHARACTER(LEN=1, KIND=C_CHAR), INTENT(IN) :: message(*)
1541  INTEGER(KIND=C_INT), INTENT(IN), VALUE :: output_unit
1542 
1543  CHARACTER(LEN=1000) :: buffer
1544  INTEGER :: nchars
1545 
1546  IF (output_unit <= 0) &
1547  RETURN
1548 
1549  ! Convert C char array into Fortran string.
1550  nchars = strlcpy_c2f(buffer, message)
1551 
1552  ! Print the message.
1553  WRITE (output_unit, fmt="(A)", advance="NO") buffer(1:nchars)
1554  END SUBROUTINE print_func
1555 
1556 END MODULE dbm_api
dbm_api
Definition: dbm_api.F:8
dbm_api::dbm_multiply
subroutine, public dbm_multiply(transa, transb, alpha, matrix_a, matrix_b, beta, matrix_c, retain_sparsity, filter_eps, flop)
Computes matrix product: matrix_c = alpha * matrix_a * matrix_b + beta * matrix_c.
Definition: dbm_api.F:736
dbm_api::dbm_redistribute
subroutine, public dbm_redistribute(matrix, redist)
Copies content of matrix_b into matrix_a. Matrices may have different distributions.
Definition: dbm_api.F:412
dbm_api::dbm_zero
subroutine, public dbm_zero(matrix)
Sets all blocks in the given matrix to zero.
Definition: dbm_api.F:662
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_maxabs
real(kind=dp) function, public dbm_maxabs(matrix)
Returns the absolute value of the larges element of the entire given matrix.
Definition: dbm_api.F:996
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_scale
subroutine, public dbm_scale(matrix, alpha)
Multiplies all entries in the given matrix by the given factor alpha.
Definition: dbm_api.F:631
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_library_init
subroutine, public dbm_library_init()
Initialize DBM library.
Definition: dbm_api.F:1483
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_stored_coordinates
subroutine, public dbm_get_stored_coordinates(matrix, row, column, processor)
Returns the MPI rank on which the given block should be stored.
Definition: dbm_api.F:1233
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_library_finalize
subroutine, public dbm_library_finalize()
Finalize DBM library.
Definition: dbm_api.F:1497
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_checksum
real(kind=dp) function, public dbm_checksum(matrix)
Computes a checksum of the given matrix.
Definition: dbm_api.F:969
dbm_api::dbm_add
subroutine, public dbm_add(matrix_a, matrix_b)
Adds matrix_b to matrix_a.
Definition: dbm_api.F:692
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_library_print_stats
subroutine, public dbm_library_print_stats(mpi_comm, output_unit)
Print DBM library statistics.
Definition: dbm_api.F:1513
dbm_api::dbm_copy
subroutine, public dbm_copy(matrix_a, matrix_b)
Copies content of matrix_b into matrix_a. Matrices must have the same row/col block sizes and distrib...
Definition: dbm_api.F:380
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
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
string_utilities
Utilities for string manipulations.
Definition: string_utilities.F:16
string_utilities::strlcpy_c2f
integer function, public strlcpy_c2f(fstring, cstring)
Copy the content of a \0-terminated C-string to a finite-length Fortran string.
Definition: string_utilities.F:3463