(git:4f6f5f6)
Loading...
Searching...
No Matches
cp_dbcsr_api.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
9 USE dbcsr_api, ONLY: &
10 convert_csr_to_dbcsr_prv => dbcsr_convert_csr_to_dbcsr, &
11 convert_dbcsr_to_csr_prv => dbcsr_convert_dbcsr_to_csr, dbcsr_add_prv => dbcsr_add, &
12 dbcsr_binary_read_prv => dbcsr_binary_read, dbcsr_binary_write_prv => dbcsr_binary_write, &
13 dbcsr_clear_mempools, dbcsr_clear_prv => dbcsr_clear, &
14 dbcsr_complete_redistribute_prv => dbcsr_complete_redistribute, &
15 dbcsr_convert_offsets_to_sizes, dbcsr_convert_sizes_to_offsets, &
16 dbcsr_copy_prv => dbcsr_copy, dbcsr_create_prv => dbcsr_create, dbcsr_csr_create, &
17 dbcsr_csr_create_from_dbcsr_prv => dbcsr_csr_create_from_dbcsr, &
18 dbcsr_csr_dbcsr_blkrow_dist, dbcsr_csr_destroy, dbcsr_csr_eqrow_floor_dist, &
19 dbcsr_csr_p_type, dbcsr_csr_print_sparsity, dbcsr_csr_type, &
20 dbcsr_csr_type_real_8 => dbcsr_type_real_8, dbcsr_csr_write, &
21 dbcsr_desymmetrize_prv => dbcsr_desymmetrize, dbcsr_distribute_prv => dbcsr_distribute, &
22 dbcsr_distribution_get_num_images, dbcsr_distribution_get_prv => dbcsr_distribution_get, &
23 dbcsr_distribution_hold_prv => dbcsr_distribution_hold, &
24 dbcsr_distribution_new_prv => dbcsr_distribution_new, &
25 dbcsr_distribution_release_prv => dbcsr_distribution_release, &
26 dbcsr_distribution_type_prv => dbcsr_distribution_type, dbcsr_dot_prv => dbcsr_dot, &
27 dbcsr_filter_prv => dbcsr_filter, dbcsr_finalize_lib, &
28 dbcsr_finalize_prv => dbcsr_finalize, dbcsr_get_block_p_prv => dbcsr_get_block_p, &
29 dbcsr_get_data_p_prv => dbcsr_get_data_p, dbcsr_get_data_size_prv => dbcsr_get_data_size, &
30 dbcsr_get_default_config, dbcsr_get_info_prv => dbcsr_get_info, &
31 dbcsr_get_matrix_type_prv => dbcsr_get_matrix_type, &
32 dbcsr_get_num_blocks_prv => dbcsr_get_num_blocks, &
33 dbcsr_get_occupation_prv => dbcsr_get_occupation, &
34 dbcsr_get_stored_coordinates_prv => dbcsr_get_stored_coordinates, &
35 dbcsr_has_symmetry_prv => dbcsr_has_symmetry, dbcsr_init_lib, &
36 dbcsr_iterator_blocks_left_prv => dbcsr_iterator_blocks_left, &
37 dbcsr_iterator_next_block_prv => dbcsr_iterator_next_block, &
38 dbcsr_iterator_start_prv => dbcsr_iterator_start, &
39 dbcsr_iterator_stop_prv => dbcsr_iterator_stop, &
40 dbcsr_iterator_type_prv => dbcsr_iterator_type, &
41 dbcsr_mp_grid_setup_prv => dbcsr_mp_grid_setup, dbcsr_multiply_prv => dbcsr_multiply, &
42 dbcsr_no_transpose, dbcsr_print_config, dbcsr_print_statistics, &
43 dbcsr_put_block_prv => dbcsr_put_block, dbcsr_release_prv => dbcsr_release, &
44 dbcsr_replicate_all_prv => dbcsr_replicate_all, &
45 dbcsr_reserve_blocks_prv => dbcsr_reserve_blocks, dbcsr_reset_randmat_seed, &
46 dbcsr_run_tests, dbcsr_scale_prv => dbcsr_scale, dbcsr_set_config, &
47 dbcsr_set_prv => dbcsr_set, dbcsr_sum_replicated_prv => dbcsr_sum_replicated, &
48 dbcsr_test_mm, dbcsr_transpose, dbcsr_transposed_prv => dbcsr_transposed, &
49 dbcsr_type_antisymmetric, dbcsr_type_complex_8, dbcsr_type_no_symmetry, &
50 dbcsr_type_prv => dbcsr_type, dbcsr_type_real_8, dbcsr_type_symmetric, &
51 dbcsr_valid_index_prv => dbcsr_valid_index, &
52 dbcsr_verify_matrix_prv => dbcsr_verify_matrix, dbcsr_work_create_prv => dbcsr_work_create
53 USE dbm_api, ONLY: &
56 USE kinds, ONLY: dp,&
57 int_8
58 USE mathconstants, ONLY: gaussi,&
59 z_one
61#include "../base/base_uses.f90"
62
63 IMPLICIT NONE
64 PRIVATE
65
66 ! constants
67 PUBLIC :: dbcsr_type_no_symmetry
68 PUBLIC :: dbcsr_type_symmetric
69 PUBLIC :: dbcsr_type_antisymmetric
70 PUBLIC :: dbcsr_transpose
71 PUBLIC :: dbcsr_no_transpose
72
73 ! types
74 PUBLIC :: dbcsr_type
75 PUBLIC :: dbcsr_p_type
77 PUBLIC :: dbcsr_iterator_type
78
79 ! lib init/finalize
80 PUBLIC :: dbcsr_clear_mempools
81 PUBLIC :: dbcsr_init_lib
82 PUBLIC :: dbcsr_finalize_lib
83 PUBLIC :: dbcsr_set_config
84 PUBLIC :: dbcsr_get_default_config
85 PUBLIC :: dbcsr_print_config
86 PUBLIC :: dbcsr_reset_randmat_seed
87 PUBLIC :: dbcsr_mp_grid_setup
88 PUBLIC :: dbcsr_print_statistics
89
90 ! create / release
94 PUBLIC :: dbcsr_create
95 PUBLIC :: dbcsr_init_p
96 PUBLIC :: dbcsr_release
97 PUBLIC :: dbcsr_release_p
99
100 ! primitive matrix operations
101 PUBLIC :: dbcsr_set
102 PUBLIC :: dbcsr_add
103 PUBLIC :: dbcsr_scale
104 PUBLIC :: dbcsr_transposed
105 PUBLIC :: dbcsr_multiply
106 PUBLIC :: dbcsr_copy
107 PUBLIC :: dbcsr_desymmetrize
108 PUBLIC :: dbcsr_filter
110 PUBLIC :: dbcsr_reserve_blocks
111 PUBLIC :: dbcsr_put_block
112 PUBLIC :: dbcsr_get_block_p
114 PUBLIC :: dbcsr_clear
115
116 ! iterator
117 PUBLIC :: dbcsr_iterator_start
119 PUBLIC :: dbcsr_iterator_stop
122
123 ! getters
124 PUBLIC :: dbcsr_get_info
125 PUBLIC :: dbcsr_distribution_get
126 PUBLIC :: dbcsr_get_matrix_type
127 PUBLIC :: dbcsr_get_occupation
128 PUBLIC :: dbcsr_get_num_blocks
129 PUBLIC :: dbcsr_get_data_size
130 PUBLIC :: dbcsr_has_symmetry
132 PUBLIC :: dbcsr_valid_index
133
134 ! work operations
135 PUBLIC :: dbcsr_work_create
136 PUBLIC :: dbcsr_verify_matrix
137 PUBLIC :: dbcsr_get_data_p
138 PUBLIC :: dbcsr_finalize
139
140 ! replication
141 PUBLIC :: dbcsr_replicate_all
142 PUBLIC :: dbcsr_sum_replicated
143 PUBLIC :: dbcsr_distribute
144
145 ! misc
146 PUBLIC :: dbcsr_distribution_get_num_images
147 PUBLIC :: dbcsr_convert_offsets_to_sizes
148 PUBLIC :: dbcsr_convert_sizes_to_offsets
149 PUBLIC :: dbcsr_run_tests
150 PUBLIC :: dbcsr_test_mm
151 PUBLIC :: dbcsr_dot_threadsafe
152
153 ! csr conversion
154 PUBLIC :: dbcsr_csr_type
155 PUBLIC :: dbcsr_csr_p_type
159 PUBLIC :: dbcsr_csr_destroy
160 PUBLIC :: dbcsr_csr_create
161 PUBLIC :: dbcsr_csr_eqrow_floor_dist
162 PUBLIC :: dbcsr_csr_dbcsr_blkrow_dist
163 PUBLIC :: dbcsr_csr_print_sparsity
164 PUBLIC :: dbcsr_csr_write
166 PUBLIC :: dbcsr_csr_type_real_8
167
168 ! binary io
169 PUBLIC :: dbcsr_binary_write
170 PUBLIC :: dbcsr_binary_read
171
173 TYPE(dbcsr_type), POINTER :: matrix => null()
174 END TYPE dbcsr_p_type
175
177 PRIVATE
178 TYPE(dbcsr_type_prv) :: dbcsr = dbcsr_type_prv()
179 TYPE(dbm_type) :: dbm = dbm_type()
180 END TYPE dbcsr_type
181
183 PRIVATE
184 TYPE(dbcsr_distribution_type_prv) :: dbcsr = dbcsr_distribution_type_prv()
187
189 PRIVATE
190 TYPE(dbcsr_iterator_type_prv) :: dbcsr = dbcsr_iterator_type_prv()
191 TYPE(dbm_iterator) :: dbm = dbm_iterator()
192 END TYPE dbcsr_iterator_type
193
194 INTERFACE dbcsr_create
195 MODULE PROCEDURE dbcsr_create_new, dbcsr_create_template
196 END INTERFACE
197
198 LOGICAL, PARAMETER, PRIVATE :: USE_DBCSR_BACKEND = .true.
199
200CONTAINS
201
202! **************************************************************************************************
203!> \brief ...
204!> \param matrix ...
205! **************************************************************************************************
206 SUBROUTINE dbcsr_init_p(matrix)
207 TYPE(dbcsr_type), POINTER :: matrix
208
209 IF (ASSOCIATED(matrix)) THEN
210 CALL dbcsr_release(matrix)
211 DEALLOCATE (matrix)
212 END IF
213
214 ALLOCATE (matrix)
215 END SUBROUTINE dbcsr_init_p
216
217! **************************************************************************************************
218!> \brief ...
219!> \param matrix ...
220! **************************************************************************************************
221 SUBROUTINE dbcsr_release_p(matrix)
222 TYPE(dbcsr_type), POINTER :: matrix
223
224 IF (ASSOCIATED(matrix)) THEN
225 CALL dbcsr_release(matrix)
226 DEALLOCATE (matrix)
227 END IF
228 END SUBROUTINE dbcsr_release_p
229
230! **************************************************************************************************
231!> \brief ...
232!> \param matrix ...
233! **************************************************************************************************
234 SUBROUTINE dbcsr_deallocate_matrix(matrix)
235 TYPE(dbcsr_type), POINTER :: matrix
236
237 CALL dbcsr_release(matrix)
238 IF (dbcsr_valid_index(matrix)) THEN
239 CALL cp_abort(__location__, &
240 'You should not "deallocate" a referenced matrix. '// &
241 'Avoid pointers to DBCSR matrices.')
242 END IF
243 DEALLOCATE (matrix)
244 END SUBROUTINE dbcsr_deallocate_matrix
245
246! **************************************************************************************************
247!> \brief ...
248!> \param matrix_a ...
249!> \param matrix_b ...
250!> \param alpha_scalar ...
251!> \param beta_scalar ...
252! **************************************************************************************************
253 SUBROUTINE dbcsr_add(matrix_a, matrix_b, alpha_scalar, beta_scalar)
254 TYPE(dbcsr_type), INTENT(INOUT) :: matrix_a
255 TYPE(dbcsr_type), INTENT(IN) :: matrix_b
256 REAL(kind=dp), INTENT(IN) :: alpha_scalar, beta_scalar
257
258 IF (use_dbcsr_backend) THEN
259 CALL dbcsr_add_prv(matrix_a%dbcsr, matrix_b%dbcsr, alpha_scalar, beta_scalar)
260 ELSE
261 IF (alpha_scalar /= 1.0_dp .OR. beta_scalar /= 1.0_dp) cpabort("Not yet implemented for DBM.")
262 CALL dbm_add(matrix_a%dbm, matrix_b%dbm)
263 END IF
264 END SUBROUTINE dbcsr_add
265
266! **************************************************************************************************
267!> \brief ...
268!> \param filepath ...
269!> \param distribution ...
270!> \param matrix_new ...
271! **************************************************************************************************
272 SUBROUTINE dbcsr_binary_read(filepath, distribution, matrix_new)
273 CHARACTER(len=*), INTENT(IN) :: filepath
274 TYPE(dbcsr_distribution_type), INTENT(IN) :: distribution
275 TYPE(dbcsr_type), INTENT(INOUT) :: matrix_new
276
277 IF (use_dbcsr_backend) THEN
278 CALL dbcsr_binary_read_prv(filepath, distribution%dbcsr, matrix_new%dbcsr)
279 ELSE
280 cpabort("Not yet implemented for DBM.")
281 END IF
282 END SUBROUTINE dbcsr_binary_read
283
284! **************************************************************************************************
285!> \brief ...
286!> \param matrix ...
287!> \param filepath ...
288! **************************************************************************************************
289 SUBROUTINE dbcsr_binary_write(matrix, filepath)
290 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
291 CHARACTER(LEN=*), INTENT(IN) :: filepath
292
293 IF (use_dbcsr_backend) THEN
294 CALL dbcsr_binary_write_prv(matrix%dbcsr, filepath)
295 ELSE
296 cpabort("Not yet implemented for DBM.")
297 END IF
298 END SUBROUTINE dbcsr_binary_write
299
300! **************************************************************************************************
301!> \brief ...
302!> \param matrix ...
303! **************************************************************************************************
304 SUBROUTINE dbcsr_clear(matrix)
305 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
306
307 IF (use_dbcsr_backend) THEN
308 CALL dbcsr_clear_prv(matrix%dbcsr)
309 ELSE
310 CALL dbm_clear(matrix%dbm)
311 END IF
312 END SUBROUTINE dbcsr_clear
313
314! **************************************************************************************************
315!> \brief ...
316!> \param matrix ...
317!> \param redist ...
318! **************************************************************************************************
319 SUBROUTINE dbcsr_complete_redistribute(matrix, redist)
320 TYPE(dbcsr_type), INTENT(IN) :: matrix
321 TYPE(dbcsr_type), INTENT(INOUT) :: redist
322
323 IF (use_dbcsr_backend) THEN
324 CALL dbcsr_complete_redistribute_prv(matrix%dbcsr, redist%dbcsr)
325 ELSE
326 CALL dbm_redistribute(matrix%dbm, redist%dbm)
327 END IF
328 END SUBROUTINE dbcsr_complete_redistribute
329
330! **************************************************************************************************
331!> \brief ...
332!> \param dbcsr_mat ...
333!> \param csr_mat ...
334! **************************************************************************************************
335 SUBROUTINE dbcsr_convert_csr_to_dbcsr(dbcsr_mat, csr_mat)
336 TYPE(dbcsr_type), INTENT(INOUT) :: dbcsr_mat
337 TYPE(dbcsr_csr_type), INTENT(INOUT) :: csr_mat
338
339 IF (use_dbcsr_backend) THEN
340 CALL convert_csr_to_dbcsr_prv(dbcsr_mat%dbcsr, csr_mat)
341 ELSE
342 cpabort("Not yet implemented for DBM.")
343 END IF
344 END SUBROUTINE dbcsr_convert_csr_to_dbcsr
345
346! **************************************************************************************************
347!> \brief ...
348!> \param dbcsr_mat ...
349!> \param csr_mat ...
350! **************************************************************************************************
351 SUBROUTINE dbcsr_convert_dbcsr_to_csr(dbcsr_mat, csr_mat)
352 TYPE(dbcsr_type), INTENT(IN) :: dbcsr_mat
353 TYPE(dbcsr_csr_type), INTENT(INOUT) :: csr_mat
354
355 IF (use_dbcsr_backend) THEN
356 CALL convert_dbcsr_to_csr_prv(dbcsr_mat%dbcsr, csr_mat)
357 ELSE
358 cpabort("Not yet implemented for DBM.")
359 END IF
360 END SUBROUTINE dbcsr_convert_dbcsr_to_csr
361
362! **************************************************************************************************
363!> \brief ...
364!> \param matrix_b ...
365!> \param matrix_a ...
366!> \param name ...
367!> \param keep_sparsity ...
368!> \param keep_imaginary ...
369! **************************************************************************************************
370 SUBROUTINE dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
371 TYPE(dbcsr_type), INTENT(INOUT) :: matrix_b
372 TYPE(dbcsr_type), INTENT(IN) :: matrix_a
373 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name
374 LOGICAL, INTENT(IN), OPTIONAL :: keep_sparsity, keep_imaginary
375
376 IF (use_dbcsr_backend) THEN
377 CALL dbcsr_copy_prv(matrix_b%dbcsr, matrix_a%dbcsr, name=name, &
378 keep_sparsity=keep_sparsity, keep_imaginary=keep_imaginary)
379 ELSE
380 IF (PRESENT(name) .OR. PRESENT(keep_sparsity) .OR. PRESENT(keep_imaginary)) THEN
381 cpabort("Not yet implemented for DBM.")
382 END IF
383 CALL dbm_copy(matrix_b%dbm, matrix_a%dbm)
384 END IF
385 END SUBROUTINE dbcsr_copy
386
387! **************************************************************************************************
388!> \brief ...
389!> \param matrix ...
390!> \param name ...
391!> \param dist ...
392!> \param matrix_type ...
393!> \param row_blk_size ...
394!> \param col_blk_size ...
395!> \param reuse_arrays ...
396!> \param mutable_work ...
397! **************************************************************************************************
398 SUBROUTINE dbcsr_create_new(matrix, name, dist, matrix_type, row_blk_size, col_blk_size, &
399 reuse_arrays, mutable_work)
400 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
401 CHARACTER(len=*), INTENT(IN) :: name
402 TYPE(dbcsr_distribution_type), INTENT(IN) :: dist
403 CHARACTER, INTENT(IN) :: matrix_type
404 INTEGER, DIMENSION(:), INTENT(INOUT), POINTER :: row_blk_size, col_blk_size
405 LOGICAL, INTENT(IN), OPTIONAL :: reuse_arrays, mutable_work
406
407 IF (use_dbcsr_backend) THEN
408 CALL dbcsr_create_prv(matrix=matrix%dbcsr, name=name, dist=dist%dbcsr, &
409 matrix_type=matrix_type, row_blk_size=row_blk_size, &
410 col_blk_size=col_blk_size, nze=0, data_type=dbcsr_type_real_8, &
411 reuse_arrays=reuse_arrays, mutable_work=mutable_work)
412 ELSE
413 cpabort("Not yet implemented for DBM.")
414 END IF
415 END SUBROUTINE dbcsr_create_new
416
417! **************************************************************************************************
418!> \brief ...
419!> \param matrix ...
420!> \param name ...
421!> \param template ...
422!> \param dist ...
423!> \param matrix_type ...
424!> \param row_blk_size ...
425!> \param col_blk_size ...
426!> \param reuse_arrays ...
427!> \param mutable_work ...
428! **************************************************************************************************
429 SUBROUTINE dbcsr_create_template(matrix, name, template, dist, matrix_type, &
430 row_blk_size, col_blk_size, reuse_arrays, mutable_work)
431 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
432 CHARACTER(len=*), INTENT(IN), OPTIONAL :: name
433 TYPE(dbcsr_type), INTENT(IN) :: template
434 TYPE(dbcsr_distribution_type), INTENT(IN), &
435 OPTIONAL :: dist
436 CHARACTER, INTENT(IN), OPTIONAL :: matrix_type
437 INTEGER, DIMENSION(:), INTENT(INOUT), OPTIONAL, &
438 POINTER :: row_blk_size, col_blk_size
439 LOGICAL, INTENT(IN), OPTIONAL :: reuse_arrays, mutable_work
440
441 IF (use_dbcsr_backend) THEN
442 IF (PRESENT(dist)) THEN
443 CALL dbcsr_create_prv(matrix=matrix%dbcsr, name=name, template=template%dbcsr, &
444 dist=dist%dbcsr, matrix_type=matrix_type, &
445 row_blk_size=row_blk_size, col_blk_size=col_blk_size, &
446 nze=0, data_type=dbcsr_type_real_8, reuse_arrays=reuse_arrays, &
447 mutable_work=mutable_work)
448 ELSE
449 CALL dbcsr_create_prv(matrix=matrix%dbcsr, name=name, template=template%dbcsr, &
450 matrix_type=matrix_type, &
451 row_blk_size=row_blk_size, col_blk_size=col_blk_size, &
452 nze=0, data_type=dbcsr_type_real_8, reuse_arrays=reuse_arrays, &
453 mutable_work=mutable_work)
454 END IF
455 ELSE
456 cpabort("Not yet implemented for DBM.")
457 END IF
458 END SUBROUTINE dbcsr_create_template
459
460! **************************************************************************************************
461!> \brief ...
462!> \param dbcsr_mat ...
463!> \param csr_mat ...
464!> \param dist_format ...
465!> \param csr_sparsity ...
466!> \param numnodes ...
467! **************************************************************************************************
468 SUBROUTINE dbcsr_csr_create_from_dbcsr(dbcsr_mat, csr_mat, dist_format, csr_sparsity, numnodes)
469
470 TYPE(dbcsr_type), INTENT(IN) :: dbcsr_mat
471 TYPE(dbcsr_csr_type), INTENT(OUT) :: csr_mat
472 INTEGER :: dist_format
473 TYPE(dbcsr_type), INTENT(IN), OPTIONAL :: csr_sparsity
474 INTEGER, INTENT(IN), OPTIONAL :: numnodes
475
476 IF (use_dbcsr_backend) THEN
477 IF (PRESENT(csr_sparsity)) THEN
478 CALL dbcsr_csr_create_from_dbcsr_prv(dbcsr_mat%dbcsr, csr_mat, dist_format, &
479 csr_sparsity%dbcsr, numnodes)
480 ELSE
481 CALL dbcsr_csr_create_from_dbcsr_prv(dbcsr_mat%dbcsr, csr_mat, &
482 dist_format, numnodes=numnodes)
483 END IF
484 ELSE
485 cpabort("Not yet implemented for DBM.")
486 END IF
487 END SUBROUTINE dbcsr_csr_create_from_dbcsr
488
489! **************************************************************************************************
490!> \brief Combines csr_create_from_dbcsr and convert_dbcsr_to_csr to produce a complex CSR matrix.
491!> \param rmatrix Real part of the matrix.
492!> \param imatrix Imaginary part of the matrix.
493!> \param csr_mat The resulting CSR matrix.
494!> \param dist_format ...
495! **************************************************************************************************
496 SUBROUTINE dbcsr_csr_create_and_convert_complex(rmatrix, imatrix, csr_mat, dist_format)
497 TYPE(dbcsr_type), INTENT(IN) :: rmatrix, imatrix
498 TYPE(dbcsr_csr_type), INTENT(INOUT) :: csr_mat
499 INTEGER :: dist_format
500
501 TYPE(dbcsr_type) :: cmatrix, tmp_matrix
502
503 IF (use_dbcsr_backend) THEN
504 CALL dbcsr_create_prv(tmp_matrix%dbcsr, template=rmatrix%dbcsr, data_type=dbcsr_type_complex_8)
505 CALL dbcsr_create_prv(cmatrix%dbcsr, template=rmatrix%dbcsr, data_type=dbcsr_type_complex_8)
506 CALL dbcsr_copy_prv(cmatrix%dbcsr, rmatrix%dbcsr)
507 CALL dbcsr_copy_prv(tmp_matrix%dbcsr, imatrix%dbcsr)
508 CALL dbcsr_add_prv(cmatrix%dbcsr, tmp_matrix%dbcsr, z_one, gaussi)
509 CALL dbcsr_release_prv(tmp_matrix%dbcsr)
510 ! Convert to csr
511 CALL dbcsr_csr_create_from_dbcsr_prv(cmatrix%dbcsr, csr_mat, dist_format)
512 CALL convert_dbcsr_to_csr_prv(cmatrix%dbcsr, csr_mat)
513 CALL dbcsr_release_prv(cmatrix%dbcsr)
514 ELSE
515 cpabort("Not yet implemented for DBM.")
516 END IF
518
519! **************************************************************************************************
520!> \brief ...
521!> \param matrix_a ...
522!> \param matrix_b ...
523! **************************************************************************************************
524 SUBROUTINE dbcsr_desymmetrize(matrix_a, matrix_b)
525 TYPE(dbcsr_type), INTENT(IN) :: matrix_a
526 TYPE(dbcsr_type), INTENT(INOUT) :: matrix_b
527
528 IF (use_dbcsr_backend) THEN
529 CALL dbcsr_desymmetrize_prv(matrix_a%dbcsr, matrix_b%dbcsr)
530 ELSE
531 cpabort("Not yet implemented for DBM.")
532 END IF
533 END SUBROUTINE dbcsr_desymmetrize
534
535! **************************************************************************************************
536!> \brief ...
537!> \param matrix ...
538! **************************************************************************************************
539 SUBROUTINE dbcsr_distribute(matrix)
540 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
541
542 IF (use_dbcsr_backend) THEN
543 CALL dbcsr_distribute_prv(matrix%dbcsr)
544 ELSE
545 cpabort("Not yet implemented for DBM.")
546 END IF
547 END SUBROUTINE dbcsr_distribute
548
549! **************************************************************************************************
550!> \brief ...
551!> \param dist ...
552!> \param row_dist ...
553!> \param col_dist ...
554!> \param nrows ...
555!> \param ncols ...
556!> \param has_threads ...
557!> \param group ...
558!> \param mynode ...
559!> \param numnodes ...
560!> \param nprows ...
561!> \param npcols ...
562!> \param myprow ...
563!> \param mypcol ...
564!> \param pgrid ...
565!> \param subgroups_defined ...
566!> \param prow_group ...
567!> \param pcol_group ...
568! **************************************************************************************************
569 SUBROUTINE dbcsr_distribution_get(dist, row_dist, col_dist, nrows, ncols, has_threads, &
570 group, mynode, numnodes, nprows, npcols, myprow, mypcol, &
571 pgrid, subgroups_defined, prow_group, pcol_group)
572 TYPE(dbcsr_distribution_type), INTENT(IN) :: dist
573 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: row_dist, col_dist
574 INTEGER, INTENT(OUT), OPTIONAL :: nrows, ncols
575 LOGICAL, INTENT(OUT), OPTIONAL :: has_threads
576 INTEGER, INTENT(OUT), OPTIONAL :: group, mynode, numnodes, nprows, npcols, &
577 myprow, mypcol
578 INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: pgrid
579 LOGICAL, INTENT(OUT), OPTIONAL :: subgroups_defined
580 INTEGER, INTENT(OUT), OPTIONAL :: prow_group, pcol_group
581
582 IF (use_dbcsr_backend) THEN
583 CALL dbcsr_distribution_get_prv(dist%dbcsr, row_dist, col_dist, nrows, ncols, has_threads, &
584 group, mynode, numnodes, nprows, npcols, myprow, mypcol, &
585 pgrid, subgroups_defined, prow_group, pcol_group)
586 ELSE
587 cpabort("Not yet implemented for DBM.")
588 END IF
589 END SUBROUTINE dbcsr_distribution_get
590
591! **************************************************************************************************
592!> \brief ...
593!> \param dist ...
594! **************************************************************************************************
595 SUBROUTINE dbcsr_distribution_hold(dist)
596 TYPE(dbcsr_distribution_type) :: dist
597
598 IF (use_dbcsr_backend) THEN
599 CALL dbcsr_distribution_hold_prv(dist%dbcsr)
600 ELSE
601 cpabort("Not yet implemented for DBM.")
602 END IF
603 END SUBROUTINE dbcsr_distribution_hold
604
605! **************************************************************************************************
606!> \brief ...
607!> \param dist ...
608!> \param template ...
609!> \param group ...
610!> \param pgrid ...
611!> \param row_dist ...
612!> \param col_dist ...
613!> \param reuse_arrays ...
614! **************************************************************************************************
615 SUBROUTINE dbcsr_distribution_new(dist, template, group, pgrid, row_dist, col_dist, reuse_arrays)
616 TYPE(dbcsr_distribution_type), INTENT(OUT) :: dist
617 TYPE(dbcsr_distribution_type), INTENT(IN), &
618 OPTIONAL :: template
619 INTEGER, INTENT(IN), OPTIONAL :: group
620 INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: pgrid
621 INTEGER, DIMENSION(:), INTENT(INOUT), POINTER :: row_dist, col_dist
622 LOGICAL, INTENT(IN), OPTIONAL :: reuse_arrays
623
624 IF (use_dbcsr_backend) THEN
625 IF (PRESENT(template)) THEN
626 CALL dbcsr_distribution_new_prv(dist%dbcsr, template%dbcsr, group, pgrid, &
627 row_dist, col_dist, reuse_arrays)
628 ELSE
629 CALL dbcsr_distribution_new_prv(dist%dbcsr, group=group, pgrid=pgrid, &
630 row_dist=row_dist, col_dist=col_dist, &
631 reuse_arrays=reuse_arrays)
632 END IF
633 ELSE
634 cpabort("Not yet implemented for DBM.")
635 END IF
636 END SUBROUTINE dbcsr_distribution_new
637
638! **************************************************************************************************
639!> \brief ...
640!> \param dist ...
641! **************************************************************************************************
643 TYPE(dbcsr_distribution_type) :: dist
644
645 IF (use_dbcsr_backend) THEN
646 CALL dbcsr_distribution_release_prv(dist%dbcsr)
647 ELSE
648 cpabort("Not yet implemented for DBM.")
649 END IF
650 END SUBROUTINE dbcsr_distribution_release
651
652! **************************************************************************************************
653!> \brief ...
654!> \param matrix ...
655!> \param eps ...
656! **************************************************************************************************
657 SUBROUTINE dbcsr_filter(matrix, eps)
658 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
659 REAL(dp), INTENT(IN) :: eps
660
661 IF (use_dbcsr_backend) THEN
662 CALL dbcsr_filter_prv(matrix%dbcsr, eps)
663 ELSE
664 cpabort("Not yet implemented for DBM.")
665 END IF
666 END SUBROUTINE dbcsr_filter
667
668! **************************************************************************************************
669!> \brief ...
670!> \param matrix ...
671! **************************************************************************************************
672 SUBROUTINE dbcsr_finalize(matrix)
673 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
674
675 IF (use_dbcsr_backend) THEN
676 CALL dbcsr_finalize_prv(matrix%dbcsr)
677 ELSE
678 cpabort("Not yet implemented for DBM.")
679 END IF
680 END SUBROUTINE dbcsr_finalize
681
682! **************************************************************************************************
683!> \brief ...
684!> \param matrix ...
685!> \param row ...
686!> \param col ...
687!> \param block ...
688!> \param found ...
689!> \param row_size ...
690!> \param col_size ...
691! **************************************************************************************************
692 SUBROUTINE dbcsr_get_block_p(matrix, row, col, block, found, row_size, col_size)
693 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
694 INTEGER, INTENT(IN) :: row, col
695 REAL(kind=dp), DIMENSION(:, :), POINTER :: block
696 LOGICAL, INTENT(OUT) :: found
697 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size
698
699 IF (use_dbcsr_backend) THEN
700 CALL dbcsr_get_block_p_prv(matrix%dbcsr, row, col, block, found, row_size, col_size)
701 ELSE
702 cpabort("Not yet implemented for DBM.")
703 END IF
704 END SUBROUTINE dbcsr_get_block_p
705
706! **************************************************************************************************
707!> \brief Like dbcsr_get_block_p() but with matrix being INTENT(IN).
708!> When invoking this routine, the caller promises not to modify the returned block.
709!> \param matrix ...
710!> \param row ...
711!> \param col ...
712!> \param block ...
713!> \param found ...
714!> \param row_size ...
715!> \param col_size ...
716! **************************************************************************************************
717 SUBROUTINE dbcsr_get_readonly_block_p(matrix, row, col, block, found, row_size, col_size)
718 TYPE(dbcsr_type), INTENT(IN), TARGET :: matrix
719 INTEGER, INTENT(IN) :: row, col
720 REAL(kind=dp), DIMENSION(:, :), POINTER :: block
721 LOGICAL, INTENT(OUT) :: found
722 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size
723
724 TYPE(dbcsr_type), POINTER :: matrix_p
725
726 mark_used(matrix)
727 mark_used(row)
728 mark_used(col)
729 mark_used(block)
730 mark_used(found)
731 mark_used(row_size)
732 mark_used(col_size)
733 IF (use_dbcsr_backend) THEN
734 matrix_p => matrix ! Hacky workaround to shake the INTENT(IN).
735 CALL dbcsr_get_block_p_prv(matrix_p%dbcsr, row, col, block, found, row_size, col_size)
736 ELSE
737 cpabort("Not yet implemented for DBM.")
738 END IF
739 END SUBROUTINE dbcsr_get_readonly_block_p
740
741! **************************************************************************************************
742!> \brief ...
743!> \param matrix ...
744!> \param lb ...
745!> \param ub ...
746!> \return ...
747! **************************************************************************************************
748 FUNCTION dbcsr_get_data_p(matrix, lb, ub) RESULT(res)
749 TYPE(dbcsr_type), INTENT(IN) :: matrix
750 INTEGER, INTENT(IN), OPTIONAL :: lb, ub
751 REAL(kind=dp), DIMENSION(:), POINTER :: res
752
753 IF (use_dbcsr_backend) THEN
754 res => dbcsr_get_data_p_prv(matrix%dbcsr, select_data_type=0.0_dp, lb=lb, ub=ub)
755 ELSE
756 cpabort("Not yet implemented for DBM.")
757 END IF
758 END FUNCTION dbcsr_get_data_p
759
760! **************************************************************************************************
761!> \brief ...
762!> \param matrix ...
763!> \return ...
764! **************************************************************************************************
765 FUNCTION dbcsr_get_data_size(matrix) RESULT(data_size)
766 TYPE(dbcsr_type), INTENT(IN) :: matrix
767 INTEGER :: data_size
768
769 IF (use_dbcsr_backend) THEN
770 data_size = dbcsr_get_data_size_prv(matrix%dbcsr)
771 ELSE
772 cpabort("Not yet implemented for DBM.")
773 END IF
774 END FUNCTION dbcsr_get_data_size
775
776! **************************************************************************************************
777!> \brief ...
778!> \param matrix ...
779!> \param nblkrows_total ...
780!> \param nblkcols_total ...
781!> \param nfullrows_total ...
782!> \param nfullcols_total ...
783!> \param nblkrows_local ...
784!> \param nblkcols_local ...
785!> \param nfullrows_local ...
786!> \param nfullcols_local ...
787!> \param my_prow ...
788!> \param my_pcol ...
789!> \param local_rows ...
790!> \param local_cols ...
791!> \param proc_row_dist ...
792!> \param proc_col_dist ...
793!> \param row_blk_size ...
794!> \param col_blk_size ...
795!> \param row_blk_offset ...
796!> \param col_blk_offset ...
797!> \param distribution ...
798!> \param name ...
799!> \param matrix_type ...
800!> \param group ...
801! **************************************************************************************************
802 SUBROUTINE dbcsr_get_info(matrix, nblkrows_total, nblkcols_total, &
803 nfullrows_total, nfullcols_total, nblkrows_local, nblkcols_local, &
804 nfullrows_local, nfullcols_local, my_prow, my_pcol, &
805 local_rows, local_cols, proc_row_dist, proc_col_dist, &
806 row_blk_size, col_blk_size, row_blk_offset, col_blk_offset, &
807 distribution, name, matrix_type, group)
808 TYPE(dbcsr_type), INTENT(IN) :: matrix
809 INTEGER, INTENT(OUT), OPTIONAL :: nblkrows_total, nblkcols_total, nfullrows_total, &
810 nfullcols_total, nblkrows_local, nblkcols_local, nfullrows_local, nfullcols_local, &
811 my_prow, my_pcol
812 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: local_rows, local_cols, proc_row_dist, &
813 proc_col_dist, row_blk_size, col_blk_size, row_blk_offset, col_blk_offset
814 TYPE(dbcsr_distribution_type), INTENT(OUT), &
815 OPTIONAL :: distribution
816 CHARACTER(len=*), INTENT(OUT), OPTIONAL :: name
817 CHARACTER, INTENT(OUT), OPTIONAL :: matrix_type
818 TYPE(mp_comm_type), INTENT(OUT), OPTIONAL :: group
819
820 INTEGER :: group_handle
821 TYPE(dbcsr_distribution_type_prv) :: my_distribution
822
823 IF (use_dbcsr_backend) THEN
824 CALL dbcsr_get_info_prv(matrix=matrix%dbcsr, &
825 nblkrows_total=nblkrows_total, &
826 nblkcols_total=nblkcols_total, &
827 nfullrows_total=nfullrows_total, &
828 nfullcols_total=nfullcols_total, &
829 nblkrows_local=nblkrows_local, &
830 nblkcols_local=nblkcols_local, &
831 nfullrows_local=nfullrows_local, &
832 nfullcols_local=nfullcols_local, &
833 my_prow=my_prow, &
834 my_pcol=my_pcol, &
835 local_rows=local_rows, &
836 local_cols=local_cols, &
837 proc_row_dist=proc_row_dist, &
838 proc_col_dist=proc_col_dist, &
839 row_blk_size=row_blk_size, &
840 col_blk_size=col_blk_size, &
841 row_blk_offset=row_blk_offset, &
842 col_blk_offset=col_blk_offset, &
843 distribution=my_distribution, &
844 name=name, &
845 matrix_type=matrix_type, &
846 group=group_handle)
847
848 IF (PRESENT(distribution)) distribution%dbcsr = my_distribution
849 IF (PRESENT(group)) CALL group%set_handle(group_handle)
850 ELSE
851 cpabort("Not yet implemented for DBM.")
852 END IF
853 END SUBROUTINE dbcsr_get_info
854
855! **************************************************************************************************
856!> \brief ...
857!> \param matrix ...
858!> \return ...
859! **************************************************************************************************
860 FUNCTION dbcsr_get_matrix_type(matrix) RESULT(matrix_type)
861 TYPE(dbcsr_type), INTENT(IN) :: matrix
862 CHARACTER :: matrix_type
863
864 IF (use_dbcsr_backend) THEN
865 matrix_type = dbcsr_get_matrix_type_prv(matrix%dbcsr)
866 ELSE
867 cpabort("Not yet implemented for DBM.")
868 END IF
869 END FUNCTION dbcsr_get_matrix_type
870
871! **************************************************************************************************
872!> \brief ...
873!> \param matrix ...
874!> \return ...
875! **************************************************************************************************
876 FUNCTION dbcsr_get_num_blocks(matrix) RESULT(num_blocks)
877 TYPE(dbcsr_type), INTENT(IN) :: matrix
878 INTEGER :: num_blocks
879
880 IF (use_dbcsr_backend) THEN
881 num_blocks = dbcsr_get_num_blocks_prv(matrix%dbcsr)
882 ELSE
883 cpabort("Not yet implemented for DBM.")
884 END IF
885 END FUNCTION dbcsr_get_num_blocks
886
887! **************************************************************************************************
888!> \brief ...
889!> \param matrix ...
890!> \return ...
891! **************************************************************************************************
892 FUNCTION dbcsr_get_occupation(matrix) RESULT(occupation)
893 TYPE(dbcsr_type), INTENT(IN) :: matrix
894 REAL(kind=dp) :: occupation
895
896 IF (use_dbcsr_backend) THEN
897 occupation = dbcsr_get_occupation_prv(matrix%dbcsr)
898 ELSE
899 cpabort("Not yet implemented for DBM.")
900 END IF
901 END FUNCTION dbcsr_get_occupation
902
903! **************************************************************************************************
904!> \brief ...
905!> \param matrix ...
906!> \param row ...
907!> \param column ...
908!> \param processor ...
909! **************************************************************************************************
910 SUBROUTINE dbcsr_get_stored_coordinates(matrix, row, column, processor)
911 TYPE(dbcsr_type), INTENT(IN) :: matrix
912 INTEGER, INTENT(IN) :: row, column
913 INTEGER, INTENT(OUT) :: processor
914
915 IF (use_dbcsr_backend) THEN
916 CALL dbcsr_get_stored_coordinates_prv(matrix%dbcsr, row, column, processor)
917 ELSE
918 cpabort("Not yet implemented for DBM.")
919 END IF
920 END SUBROUTINE dbcsr_get_stored_coordinates
921
922! **************************************************************************************************
923!> \brief ...
924!> \param matrix ...
925!> \return ...
926! **************************************************************************************************
927 FUNCTION dbcsr_has_symmetry(matrix) RESULT(has_symmetry)
928 TYPE(dbcsr_type), INTENT(IN) :: matrix
929 LOGICAL :: has_symmetry
930
931 IF (use_dbcsr_backend) THEN
932 has_symmetry = dbcsr_has_symmetry_prv(matrix%dbcsr)
933 ELSE
934 cpabort("Not yet implemented for DBM.")
935 END IF
936 END FUNCTION dbcsr_has_symmetry
937
938! **************************************************************************************************
939!> \brief ...
940!> \param iterator ...
941!> \return ...
942! **************************************************************************************************
943 FUNCTION dbcsr_iterator_blocks_left(iterator) RESULT(blocks_left)
944 TYPE(dbcsr_iterator_type), INTENT(IN) :: iterator
945 LOGICAL :: blocks_left
946
947 IF (use_dbcsr_backend) THEN
948 blocks_left = dbcsr_iterator_blocks_left_prv(iterator%dbcsr)
949 ELSE
950 cpabort("Not yet implemented for DBM.")
951 END IF
952 END FUNCTION dbcsr_iterator_blocks_left
953
954! **************************************************************************************************
955!> \brief ...
956!> \param iterator ...
957!> \param row ...
958!> \param column ...
959!> \param block ...
960!> \param block_number_argument_has_been_removed ...
961!> \param row_size ...
962!> \param col_size ...
963!> \param row_offset ...
964!> \param col_offset ...
965!> \param transposed ...
966! **************************************************************************************************
967 SUBROUTINE dbcsr_iterator_next_block(iterator, row, column, block, &
968 block_number_argument_has_been_removed, &
969 row_size, col_size, &
970 row_offset, col_offset, transposed)
971 TYPE(dbcsr_iterator_type), INTENT(INOUT) :: iterator
972 INTEGER, INTENT(OUT), OPTIONAL :: row, column
973 REAL(kind=dp), DIMENSION(:, :), OPTIONAL, POINTER :: block
974 LOGICAL, OPTIONAL :: block_number_argument_has_been_removed
975 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size, row_offset, &
976 col_offset
977 LOGICAL, INTENT(OUT), OPTIONAL :: transposed
978
979 INTEGER :: my_column, my_row
980 REAL(kind=dp), DIMENSION(:, :), POINTER :: my_block
981
982 cpassert(.NOT. PRESENT(block_number_argument_has_been_removed))
983
984 IF (use_dbcsr_backend) THEN
985 IF (PRESENT(transposed)) THEN
986 CALL dbcsr_iterator_next_block_prv(iterator%dbcsr, row=my_row, column=my_column, &
987 block=my_block, row_size=row_size, col_size=col_size, &
988 row_offset=row_offset, col_offset=col_offset, &
989 transposed=transposed)
990 ELSE
991 CALL dbcsr_iterator_next_block_prv(iterator%dbcsr, row=my_row, column=my_column, &
992 block=my_block, row_size=row_size, col_size=col_size, &
993 row_offset=row_offset, col_offset=col_offset)
994 END IF
995 IF (PRESENT(block)) block => my_block
996 IF (PRESENT(row)) row = my_row
997 IF (PRESENT(column)) column = my_column
998 ELSE
999 cpabort("Not yet implemented for DBM.")
1000 END IF
1001 END SUBROUTINE dbcsr_iterator_next_block
1002
1003! **************************************************************************************************
1004!> \brief ...
1005!> \param iterator ...
1006!> \param matrix ...
1007!> \param shared ...
1008!> \param dynamic ...
1009!> \param dynamic_byrows ...
1010! **************************************************************************************************
1011 SUBROUTINE dbcsr_iterator_start(iterator, matrix, shared, dynamic, dynamic_byrows)
1012 TYPE(dbcsr_iterator_type), INTENT(OUT) :: iterator
1013 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1014 LOGICAL, INTENT(IN), OPTIONAL :: shared, dynamic, dynamic_byrows
1015
1016 IF (use_dbcsr_backend) THEN
1017 CALL dbcsr_iterator_start_prv(iterator%dbcsr, matrix%dbcsr, shared, dynamic, dynamic_byrows)
1018 ELSE
1019 cpabort("Not yet implemented for DBM.")
1020 END IF
1021 END SUBROUTINE dbcsr_iterator_start
1022
1023! **************************************************************************************************
1024!> \brief Like dbcsr_iterator_start() but with matrix being INTENT(IN).
1025!> When invoking this routine, the caller promises not to modify the returned blocks.
1026!> \param iterator ...
1027!> \param matrix ...
1028!> \param shared ...
1029!> \param dynamic ...
1030!> \param dynamic_byrows ...
1031! **************************************************************************************************
1032 SUBROUTINE dbcsr_iterator_readonly_start(iterator, matrix, shared, dynamic, dynamic_byrows)
1033 TYPE(dbcsr_iterator_type), INTENT(OUT) :: iterator
1034 TYPE(dbcsr_type), INTENT(IN) :: matrix
1035 LOGICAL, INTENT(IN), OPTIONAL :: shared, dynamic, dynamic_byrows
1036
1037 IF (use_dbcsr_backend) THEN
1038 CALL dbcsr_iterator_start_prv(iterator%dbcsr, matrix%dbcsr, shared, dynamic, &
1039 dynamic_byrows, read_only=.true.)
1040 ELSE
1041 cpabort("Not yet implemented for DBM.")
1042 END IF
1043 END SUBROUTINE dbcsr_iterator_readonly_start
1044
1045! **************************************************************************************************
1046!> \brief ...
1047!> \param iterator ...
1048! **************************************************************************************************
1049 SUBROUTINE dbcsr_iterator_stop(iterator)
1050 TYPE(dbcsr_iterator_type), INTENT(INOUT) :: iterator
1051
1052 IF (use_dbcsr_backend) THEN
1053 CALL dbcsr_iterator_stop_prv(iterator%dbcsr)
1054 ELSE
1055 cpabort("Not yet implemented for DBM.")
1056 END IF
1057 END SUBROUTINE dbcsr_iterator_stop
1058
1059! **************************************************************************************************
1060!> \brief ...
1061!> \param dist ...
1062! **************************************************************************************************
1063 SUBROUTINE dbcsr_mp_grid_setup(dist)
1064 TYPE(dbcsr_distribution_type), INTENT(INOUT) :: dist
1065
1066 IF (use_dbcsr_backend) THEN
1067 CALL dbcsr_mp_grid_setup_prv(dist%dbcsr)
1068 ELSE
1069 cpabort("Not yet implemented for DBM.")
1070 END IF
1071 END SUBROUTINE dbcsr_mp_grid_setup
1072
1073! **************************************************************************************************
1074!> \brief ...
1075!> \param transa ...
1076!> \param transb ...
1077!> \param alpha ...
1078!> \param matrix_a ...
1079!> \param matrix_b ...
1080!> \param beta ...
1081!> \param matrix_c ...
1082!> \param first_row ...
1083!> \param last_row ...
1084!> \param first_column ...
1085!> \param last_column ...
1086!> \param first_k ...
1087!> \param last_k ...
1088!> \param retain_sparsity ...
1089!> \param filter_eps ...
1090!> \param flop ...
1091! **************************************************************************************************
1092 SUBROUTINE dbcsr_multiply(transa, transb, alpha, matrix_a, matrix_b, beta, &
1093 matrix_c, first_row, last_row, &
1094 first_column, last_column, first_k, last_k, &
1095 retain_sparsity, filter_eps, flop)
1096 CHARACTER(LEN=1), INTENT(IN) :: transa, transb
1097 REAL(kind=dp), INTENT(IN) :: alpha
1098 TYPE(dbcsr_type), INTENT(IN) :: matrix_a, matrix_b
1099 REAL(kind=dp), INTENT(IN) :: beta
1100 TYPE(dbcsr_type), INTENT(INOUT) :: matrix_c
1101 INTEGER, INTENT(IN), OPTIONAL :: first_row, last_row, first_column, &
1102 last_column, first_k, last_k
1103 LOGICAL, INTENT(IN), OPTIONAL :: retain_sparsity
1104 REAL(kind=dp), INTENT(IN), OPTIONAL :: filter_eps
1105 INTEGER(int_8), INTENT(OUT), OPTIONAL :: flop
1106
1107 IF (use_dbcsr_backend) THEN
1108 CALL dbcsr_multiply_prv(transa, transb, alpha, matrix_a%dbcsr, matrix_b%dbcsr, beta, &
1109 matrix_c%dbcsr, first_row, last_row, first_column, last_column, &
1110 first_k, last_k, retain_sparsity, filter_eps=filter_eps, flop=flop)
1111 ELSE
1112 cpabort("Not yet implemented for DBM.")
1113 END IF
1114 END SUBROUTINE dbcsr_multiply
1115
1116! **************************************************************************************************
1117!> \brief ...
1118!> \param matrix ...
1119!> \param row ...
1120!> \param col ...
1121!> \param block ...
1122!> \param summation ...
1123! **************************************************************************************************
1124 SUBROUTINE dbcsr_put_block(matrix, row, col, block, summation)
1125 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1126 INTEGER, INTENT(IN) :: row, col
1127 REAL(kind=dp), DIMENSION(:, :), INTENT(IN) :: block
1128 LOGICAL, INTENT(IN), OPTIONAL :: summation
1129
1130 IF (use_dbcsr_backend) THEN
1131 CALL dbcsr_put_block_prv(matrix%dbcsr, row, col, block, summation=summation)
1132 ELSE
1133 cpabort("Not yet implemented for DBM.")
1134 END IF
1135 END SUBROUTINE dbcsr_put_block
1136
1137! **************************************************************************************************
1138!> \brief ...
1139!> \param matrix ...
1140! **************************************************************************************************
1141 SUBROUTINE dbcsr_release(matrix)
1142 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1143
1144 IF (use_dbcsr_backend) THEN
1145 CALL dbcsr_release_prv(matrix%dbcsr)
1146 ELSE
1147 cpabort("Not yet implemented for DBM.")
1148 END IF
1149 END SUBROUTINE dbcsr_release
1150
1151! **************************************************************************************************
1152!> \brief ...
1153!> \param matrix ...
1154! **************************************************************************************************
1155 SUBROUTINE dbcsr_replicate_all(matrix)
1156 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1157
1158 IF (use_dbcsr_backend) THEN
1159 CALL dbcsr_replicate_all_prv(matrix%dbcsr)
1160 ELSE
1161 cpabort("Not yet implemented for DBM.")
1162 END IF
1163 END SUBROUTINE dbcsr_replicate_all
1164
1165! **************************************************************************************************
1166!> \brief ...
1167!> \param matrix ...
1168!> \param rows ...
1169!> \param cols ...
1170! **************************************************************************************************
1171 SUBROUTINE dbcsr_reserve_blocks(matrix, rows, cols)
1172 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1173 INTEGER, DIMENSION(:), INTENT(IN) :: rows, cols
1174
1175 IF (use_dbcsr_backend) THEN
1176 CALL dbcsr_reserve_blocks_prv(matrix%dbcsr, rows, cols)
1177 ELSE
1178 cpabort("Not yet implemented for DBM.")
1179 END IF
1180 END SUBROUTINE dbcsr_reserve_blocks
1181
1182! **************************************************************************************************
1183!> \brief ...
1184!> \param matrix ...
1185!> \param alpha_scalar ...
1186! **************************************************************************************************
1187 SUBROUTINE dbcsr_scale(matrix, alpha_scalar)
1188 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1189 REAL(kind=dp), INTENT(IN) :: alpha_scalar
1190
1191 IF (use_dbcsr_backend) THEN
1192 CALL dbcsr_scale_prv(matrix%dbcsr, alpha_scalar)
1193 ELSE
1194 CALL dbm_scale(matrix%dbm, alpha_scalar)
1195 END IF
1196 END SUBROUTINE dbcsr_scale
1197
1198! **************************************************************************************************
1199!> \brief ...
1200!> \param matrix ...
1201!> \param alpha ...
1202! **************************************************************************************************
1203 SUBROUTINE dbcsr_set(matrix, alpha)
1204 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1205 REAL(kind=dp), INTENT(IN) :: alpha
1206
1207 IF (use_dbcsr_backend) THEN
1208 CALL dbcsr_set_prv(matrix%dbcsr, alpha)
1209 ELSE
1210 IF (alpha == 0.0_dp) THEN
1211 CALL dbm_zero(matrix%dbm)
1212 ELSE
1213 cpabort("Not yet implemented for DBM.")
1214 END IF
1215 END IF
1216 END SUBROUTINE dbcsr_set
1217
1218! **************************************************************************************************
1219!> \brief ...
1220!> \param matrix ...
1221! **************************************************************************************************
1222 SUBROUTINE dbcsr_sum_replicated(matrix)
1223 TYPE(dbcsr_type), INTENT(inout) :: matrix
1224
1225 IF (use_dbcsr_backend) THEN
1226 CALL dbcsr_sum_replicated_prv(matrix%dbcsr)
1227 ELSE
1228 cpabort("Not yet implemented for DBM.")
1229 END IF
1230 END SUBROUTINE dbcsr_sum_replicated
1231
1232! **************************************************************************************************
1233!> \brief ...
1234!> \param transposed ...
1235!> \param normal ...
1236!> \param shallow_data_copy ...
1237!> \param transpose_distribution ...
1238!> \param use_distribution ...
1239! **************************************************************************************************
1240 SUBROUTINE dbcsr_transposed(transposed, normal, shallow_data_copy, transpose_distribution, &
1241 use_distribution)
1242 TYPE(dbcsr_type), INTENT(INOUT) :: transposed
1243 TYPE(dbcsr_type), INTENT(IN) :: normal
1244 LOGICAL, INTENT(IN), OPTIONAL :: shallow_data_copy, transpose_distribution
1245 TYPE(dbcsr_distribution_type), INTENT(IN), &
1246 OPTIONAL :: use_distribution
1247
1248 IF (use_dbcsr_backend) THEN
1249 IF (PRESENT(use_distribution)) THEN
1250 CALL dbcsr_transposed_prv(transposed%dbcsr, normal%dbcsr, &
1251 shallow_data_copy=shallow_data_copy, &
1252 transpose_distribution=transpose_distribution, &
1253 use_distribution=use_distribution%dbcsr)
1254 ELSE
1255 CALL dbcsr_transposed_prv(transposed%dbcsr, normal%dbcsr, &
1256 shallow_data_copy=shallow_data_copy, &
1257 transpose_distribution=transpose_distribution)
1258 END IF
1259 ELSE
1260 cpabort("Not yet implemented for DBM.")
1261 END IF
1262 END SUBROUTINE dbcsr_transposed
1263
1264! **************************************************************************************************
1265!> \brief ...
1266!> \param matrix ...
1267!> \return ...
1268! **************************************************************************************************
1269 FUNCTION dbcsr_valid_index(matrix) RESULT(valid_index)
1270 TYPE(dbcsr_type), INTENT(IN) :: matrix
1271 LOGICAL :: valid_index
1272
1273 IF (use_dbcsr_backend) THEN
1274 valid_index = dbcsr_valid_index_prv(matrix%dbcsr)
1275 ELSE
1276 valid_index = .true. ! Does not apply to DBM.
1277 END IF
1278 END FUNCTION dbcsr_valid_index
1279
1280! **************************************************************************************************
1281!> \brief ...
1282!> \param matrix ...
1283!> \param verbosity ...
1284!> \param local ...
1285! **************************************************************************************************
1286 SUBROUTINE dbcsr_verify_matrix(matrix, verbosity, local)
1287 TYPE(dbcsr_type), INTENT(IN) :: matrix
1288 INTEGER, INTENT(IN), OPTIONAL :: verbosity
1289 LOGICAL, INTENT(IN), OPTIONAL :: local
1290
1291 IF (use_dbcsr_backend) THEN
1292 CALL dbcsr_verify_matrix_prv(matrix%dbcsr, verbosity, local)
1293 ELSE
1294 ! Does not apply to DBM.
1295 END IF
1296 END SUBROUTINE dbcsr_verify_matrix
1297
1298! **************************************************************************************************
1299!> \brief ...
1300!> \param matrix ...
1301!> \param nblks_guess ...
1302!> \param sizedata_guess ...
1303!> \param n ...
1304!> \param work_mutable ...
1305! **************************************************************************************************
1306 SUBROUTINE dbcsr_work_create(matrix, nblks_guess, sizedata_guess, n, work_mutable)
1307 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1308 INTEGER, INTENT(IN), OPTIONAL :: nblks_guess, sizedata_guess, n
1309 LOGICAL, INTENT(in), OPTIONAL :: work_mutable
1310
1311 IF (use_dbcsr_backend) THEN
1312 CALL dbcsr_work_create_prv(matrix%dbcsr, nblks_guess, sizedata_guess, n, work_mutable)
1313 ELSE
1314 ! Does not apply to DBM.
1315 END IF
1316 END SUBROUTINE dbcsr_work_create
1317
1318! **************************************************************************************************
1319!> \brief ...
1320!> \param matrix_a ...
1321!> \param matrix_b ...
1322!> \param RESULT ...
1323! **************************************************************************************************
1324 SUBROUTINE dbcsr_dot_threadsafe(matrix_a, matrix_b, RESULT)
1325 TYPE(dbcsr_type), INTENT(IN) :: matrix_a, matrix_b
1326 REAL(kind=dp), INTENT(INOUT) :: result
1327
1328 IF (use_dbcsr_backend) THEN
1329 CALL dbcsr_dot_prv(matrix_a%dbcsr, matrix_b%dbcsr, result)
1330 ELSE
1331 cpabort("Not yet implemented for DBM.")
1332 END IF
1333 END SUBROUTINE dbcsr_dot_threadsafe
1334
1335END MODULE cp_dbcsr_api
subroutine, public dbcsr_verify_matrix(matrix, verbosity, local)
...
subroutine, public dbcsr_transposed(transposed, normal, shallow_data_copy, transpose_distribution, use_distribution)
...
subroutine, public dbcsr_distribution_release(dist)
...
logical function, public dbcsr_has_symmetry(matrix)
...
subroutine, public dbcsr_release_p(matrix)
...
integer function, public dbcsr_get_data_size(matrix)
...
subroutine, public dbcsr_get_readonly_block_p(matrix, row, col, block, found, row_size, col_size)
Like dbcsr_get_block_p() but with matrix being INTENT(IN). When invoking this routine,...
subroutine, public dbcsr_scale(matrix, alpha_scalar)
...
subroutine, public dbcsr_convert_dbcsr_to_csr(dbcsr_mat, csr_mat)
...
subroutine, public dbcsr_distribution_new(dist, template, group, pgrid, row_dist, col_dist, reuse_arrays)
...
subroutine, public dbcsr_deallocate_matrix(matrix)
...
character function, public dbcsr_get_matrix_type(matrix)
...
logical function, public dbcsr_iterator_blocks_left(iterator)
...
subroutine, public dbcsr_distribution_hold(dist)
...
subroutine, public dbcsr_iterator_stop(iterator)
...
subroutine, public dbcsr_convert_csr_to_dbcsr(dbcsr_mat, csr_mat)
...
logical function, public dbcsr_valid_index(matrix)
...
subroutine, public dbcsr_desymmetrize(matrix_a, matrix_b)
...
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
subroutine, public dbcsr_get_block_p(matrix, row, col, block, found, row_size, col_size)
...
subroutine, public dbcsr_multiply(transa, transb, alpha, matrix_a, matrix_b, beta, matrix_c, first_row, last_row, first_column, last_column, first_k, last_k, retain_sparsity, filter_eps, flop)
...
subroutine, public dbcsr_replicate_all(matrix)
...
subroutine, public dbcsr_get_info(matrix, nblkrows_total, nblkcols_total, nfullrows_total, nfullcols_total, nblkrows_local, nblkcols_local, nfullrows_local, nfullcols_local, my_prow, my_pcol, local_rows, local_cols, proc_row_dist, proc_col_dist, row_blk_size, col_blk_size, row_blk_offset, col_blk_offset, distribution, name, matrix_type, group)
...
subroutine, public dbcsr_reserve_blocks(matrix, rows, cols)
...
subroutine, public dbcsr_get_stored_coordinates(matrix, row, column, processor)
...
subroutine, public dbcsr_csr_create_and_convert_complex(rmatrix, imatrix, csr_mat, dist_format)
Combines csr_create_from_dbcsr and convert_dbcsr_to_csr to produce a complex CSR matrix.
subroutine, public dbcsr_init_p(matrix)
...
subroutine, public dbcsr_csr_create_from_dbcsr(dbcsr_mat, csr_mat, dist_format, csr_sparsity, numnodes)
...
subroutine, public dbcsr_distribute(matrix)
...
real(kind=dp) function, dimension(:), pointer, public dbcsr_get_data_p(matrix, lb, ub)
...
subroutine, public dbcsr_work_create(matrix, nblks_guess, sizedata_guess, n, work_mutable)
...
subroutine, public dbcsr_sum_replicated(matrix)
...
subroutine, public dbcsr_iterator_next_block(iterator, row, column, block, block_number_argument_has_been_removed, row_size, col_size, row_offset, col_offset, transposed)
...
subroutine, public dbcsr_filter(matrix, eps)
...
subroutine, public dbcsr_binary_write(matrix, filepath)
...
real(kind=dp) function, public dbcsr_get_occupation(matrix)
...
subroutine, public dbcsr_dot_threadsafe(matrix_a, matrix_b, result)
...
subroutine, public dbcsr_finalize(matrix)
...
subroutine, public dbcsr_iterator_start(iterator, matrix, shared, dynamic, dynamic_byrows)
...
subroutine, public dbcsr_set(matrix, alpha)
...
subroutine, public dbcsr_release(matrix)
...
subroutine, public dbcsr_complete_redistribute(matrix, redist)
...
integer function, public dbcsr_get_num_blocks(matrix)
...
subroutine, public dbcsr_iterator_readonly_start(iterator, matrix, shared, dynamic, dynamic_byrows)
Like dbcsr_iterator_start() but with matrix being INTENT(IN). When invoking this routine,...
subroutine, public dbcsr_mp_grid_setup(dist)
...
subroutine, public dbcsr_binary_read(filepath, distribution, matrix_new)
...
subroutine, public dbcsr_clear(matrix)
...
subroutine, public dbcsr_put_block(matrix, row, col, block, summation)
...
subroutine, public dbcsr_add(matrix_a, matrix_b, alpha_scalar, beta_scalar)
...
subroutine, public dbcsr_distribution_get(dist, row_dist, col_dist, nrows, ncols, has_threads, group, mynode, numnodes, nprows, npcols, myprow, mypcol, pgrid, subgroups_defined, prow_group, pcol_group)
...
subroutine, public dbm_redistribute(matrix, redist)
Copies content of matrix_b into matrix_a. Matrices may have different distributions.
Definition dbm_api.F:412
subroutine, public dbm_zero(matrix)
Sets all blocks in the given matrix to zero.
Definition dbm_api.F:662
subroutine, public dbm_clear(matrix)
Remove all blocks from given matrix, but does not release the underlying memory.
Definition dbm_api.F:529
subroutine, public dbm_scale(matrix, alpha)
Multiplies all entries in the given matrix by the given factor alpha.
Definition dbm_api.F:631
subroutine, public dbm_add(matrix_a, matrix_b)
Adds matrix_b to matrix_a.
Definition dbm_api.F:692
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
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public int_8
Definition kinds.F:54
integer, parameter, public dp
Definition kinds.F:34
Definition of mathematical constants and functions.
complex(kind=dp), parameter, public z_one
complex(kind=dp), parameter, public gaussi
Interface to the message passing library MPI.