(git:42dac4a)
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-2025 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
59#include "../base/base_uses.f90"
60
61 IMPLICIT NONE
62 PRIVATE
63
64 ! constants
65 PUBLIC :: dbcsr_type_no_symmetry
66 PUBLIC :: dbcsr_type_symmetric
67 PUBLIC :: dbcsr_type_antisymmetric
68 PUBLIC :: dbcsr_transpose
69 PUBLIC :: dbcsr_no_transpose
70
71 ! types
72 PUBLIC :: dbcsr_type
73 PUBLIC :: dbcsr_p_type
75 PUBLIC :: dbcsr_iterator_type
76
77 ! lib init/finalize
78 PUBLIC :: dbcsr_clear_mempools
79 PUBLIC :: dbcsr_init_lib
80 PUBLIC :: dbcsr_finalize_lib
81 PUBLIC :: dbcsr_set_config
82 PUBLIC :: dbcsr_get_default_config
83 PUBLIC :: dbcsr_print_config
84 PUBLIC :: dbcsr_reset_randmat_seed
85 PUBLIC :: dbcsr_mp_grid_setup
86 PUBLIC :: dbcsr_print_statistics
87
88 ! create / release
92 PUBLIC :: dbcsr_create
93 PUBLIC :: dbcsr_init_p
94 PUBLIC :: dbcsr_release
95 PUBLIC :: dbcsr_release_p
97
98 ! primitive matrix operations
99 PUBLIC :: dbcsr_set
100 PUBLIC :: dbcsr_add
101 PUBLIC :: dbcsr_scale
102 PUBLIC :: dbcsr_transposed
103 PUBLIC :: dbcsr_multiply
104 PUBLIC :: dbcsr_copy
105 PUBLIC :: dbcsr_desymmetrize
106 PUBLIC :: dbcsr_filter
108 PUBLIC :: dbcsr_reserve_blocks
109 PUBLIC :: dbcsr_put_block
110 PUBLIC :: dbcsr_get_block_p
112 PUBLIC :: dbcsr_clear
113
114 ! iterator
115 PUBLIC :: dbcsr_iterator_start
117 PUBLIC :: dbcsr_iterator_stop
120
121 ! getters
122 PUBLIC :: dbcsr_get_info
123 PUBLIC :: dbcsr_distribution_get
124 PUBLIC :: dbcsr_get_matrix_type
125 PUBLIC :: dbcsr_get_occupation
126 PUBLIC :: dbcsr_get_num_blocks
127 PUBLIC :: dbcsr_get_data_size
128 PUBLIC :: dbcsr_has_symmetry
130 PUBLIC :: dbcsr_valid_index
131
132 ! work operations
133 PUBLIC :: dbcsr_work_create
134 PUBLIC :: dbcsr_verify_matrix
135 PUBLIC :: dbcsr_get_data_p
136 PUBLIC :: dbcsr_finalize
137
138 ! replication
139 PUBLIC :: dbcsr_replicate_all
140 PUBLIC :: dbcsr_sum_replicated
141 PUBLIC :: dbcsr_distribute
142
143 ! misc
144 PUBLIC :: dbcsr_distribution_get_num_images
145 PUBLIC :: dbcsr_convert_offsets_to_sizes
146 PUBLIC :: dbcsr_convert_sizes_to_offsets
147 PUBLIC :: dbcsr_run_tests
148 PUBLIC :: dbcsr_test_mm
149 PUBLIC :: dbcsr_dot_threadsafe
150
151 ! csr conversion
152 PUBLIC :: dbcsr_csr_type
153 PUBLIC :: dbcsr_csr_p_type
157 PUBLIC :: dbcsr_csr_destroy
158 PUBLIC :: dbcsr_csr_create
159 PUBLIC :: dbcsr_csr_eqrow_floor_dist
160 PUBLIC :: dbcsr_csr_dbcsr_blkrow_dist
161 PUBLIC :: dbcsr_csr_print_sparsity
162 PUBLIC :: dbcsr_csr_write
164 PUBLIC :: dbcsr_csr_type_real_8
165
166 ! binary io
167 PUBLIC :: dbcsr_binary_write
168 PUBLIC :: dbcsr_binary_read
169
171 TYPE(dbcsr_type), POINTER :: matrix => null()
172 END TYPE
173
175 PRIVATE
176 TYPE(dbcsr_type_prv) :: dbcsr = dbcsr_type_prv()
177 TYPE(dbm_type) :: dbm = dbm_type()
178 END TYPE dbcsr_type
179
181 PRIVATE
182 TYPE(dbcsr_distribution_type_prv) :: dbcsr = dbcsr_distribution_type_prv()
185
187 PRIVATE
188 TYPE(dbcsr_iterator_type_prv) :: dbcsr = dbcsr_iterator_type_prv()
189 TYPE(dbm_iterator) :: dbm = dbm_iterator()
190 END TYPE dbcsr_iterator_type
191
192 INTERFACE dbcsr_create
193 MODULE PROCEDURE dbcsr_create_new, dbcsr_create_template
194 END INTERFACE
195
196 LOGICAL, PARAMETER, PRIVATE :: USE_DBCSR_BACKEND = .true.
197
198CONTAINS
199
200! **************************************************************************************************
201!> \brief ...
202!> \param matrix ...
203! **************************************************************************************************
204 SUBROUTINE dbcsr_init_p(matrix)
205 TYPE(dbcsr_type), POINTER :: matrix
206
207 IF (ASSOCIATED(matrix)) THEN
208 CALL dbcsr_release(matrix)
209 DEALLOCATE (matrix)
210 END IF
211
212 ALLOCATE (matrix)
213 END SUBROUTINE dbcsr_init_p
214
215! **************************************************************************************************
216!> \brief ...
217!> \param matrix ...
218! **************************************************************************************************
219 SUBROUTINE dbcsr_release_p(matrix)
220 TYPE(dbcsr_type), POINTER :: matrix
221
222 IF (ASSOCIATED(matrix)) THEN
223 CALL dbcsr_release(matrix)
224 DEALLOCATE (matrix)
225 END IF
226 END SUBROUTINE dbcsr_release_p
227
228! **************************************************************************************************
229!> \brief ...
230!> \param matrix ...
231! **************************************************************************************************
232 SUBROUTINE dbcsr_deallocate_matrix(matrix)
233 TYPE(dbcsr_type), POINTER :: matrix
234
235 CALL dbcsr_release(matrix)
236 IF (dbcsr_valid_index(matrix)) &
237 CALL cp_abort(__location__, &
238 'You should not "deallocate" a referenced matrix. '// &
239 'Avoid pointers to DBCSR matrices.')
240 DEALLOCATE (matrix)
241 END SUBROUTINE dbcsr_deallocate_matrix
242
243! **************************************************************************************************
244!> \brief ...
245!> \param matrix_a ...
246!> \param matrix_b ...
247!> \param alpha_scalar ...
248!> \param beta_scalar ...
249! **************************************************************************************************
250 SUBROUTINE dbcsr_add(matrix_a, matrix_b, alpha_scalar, beta_scalar)
251 TYPE(dbcsr_type), INTENT(INOUT) :: matrix_a
252 TYPE(dbcsr_type), INTENT(IN) :: matrix_b
253 REAL(kind=dp), INTENT(IN) :: alpha_scalar, beta_scalar
254
255 IF (use_dbcsr_backend) THEN
256 CALL dbcsr_add_prv(matrix_a%dbcsr, matrix_b%dbcsr, alpha_scalar, beta_scalar)
257 ELSE
258 IF (alpha_scalar /= 1.0_dp .OR. beta_scalar /= 1.0_dp) cpabort("Not yet implemented for DBM.")
259 CALL dbm_add(matrix_a%dbm, matrix_b%dbm)
260 END IF
261 END SUBROUTINE dbcsr_add
262
263! **************************************************************************************************
264!> \brief ...
265!> \param filepath ...
266!> \param distribution ...
267!> \param matrix_new ...
268! **************************************************************************************************
269 SUBROUTINE dbcsr_binary_read(filepath, distribution, matrix_new)
270 CHARACTER(len=*), INTENT(IN) :: filepath
271 TYPE(dbcsr_distribution_type), INTENT(IN) :: distribution
272 TYPE(dbcsr_type), INTENT(INOUT) :: matrix_new
273
274 IF (use_dbcsr_backend) THEN
275 CALL dbcsr_binary_read_prv(filepath, distribution%dbcsr, matrix_new%dbcsr)
276 ELSE
277 cpabort("Not yet implemented for DBM.")
278 END IF
279 END SUBROUTINE dbcsr_binary_read
280
281! **************************************************************************************************
282!> \brief ...
283!> \param matrix ...
284!> \param filepath ...
285! **************************************************************************************************
286 SUBROUTINE dbcsr_binary_write(matrix, filepath)
287 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
288 CHARACTER(LEN=*), INTENT(IN) :: filepath
289
290 IF (use_dbcsr_backend) THEN
291 CALL dbcsr_binary_write_prv(matrix%dbcsr, filepath)
292 ELSE
293 cpabort("Not yet implemented for DBM.")
294 END IF
295 END SUBROUTINE dbcsr_binary_write
296
297! **************************************************************************************************
298!> \brief ...
299!> \param matrix ...
300! **************************************************************************************************
301 SUBROUTINE dbcsr_clear(matrix)
302 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
303
304 IF (use_dbcsr_backend) THEN
305 CALL dbcsr_clear_prv(matrix%dbcsr)
306 ELSE
307 CALL dbm_clear(matrix%dbm)
308 END IF
309 END SUBROUTINE
310
311! **************************************************************************************************
312!> \brief ...
313!> \param matrix ...
314!> \param redist ...
315! **************************************************************************************************
316 SUBROUTINE dbcsr_complete_redistribute(matrix, redist)
317 TYPE(dbcsr_type), INTENT(IN) :: matrix
318 TYPE(dbcsr_type), INTENT(INOUT) :: redist
319
320 IF (use_dbcsr_backend) THEN
321 CALL dbcsr_complete_redistribute_prv(matrix%dbcsr, redist%dbcsr)
322 ELSE
323 CALL dbm_redistribute(matrix%dbm, redist%dbm)
324 END IF
325 END SUBROUTINE dbcsr_complete_redistribute
326
327! **************************************************************************************************
328!> \brief ...
329!> \param dbcsr_mat ...
330!> \param csr_mat ...
331! **************************************************************************************************
332 SUBROUTINE dbcsr_convert_csr_to_dbcsr(dbcsr_mat, csr_mat)
333 TYPE(dbcsr_type), INTENT(INOUT) :: dbcsr_mat
334 TYPE(dbcsr_csr_type), INTENT(INOUT) :: csr_mat
335
336 IF (use_dbcsr_backend) THEN
337 CALL convert_csr_to_dbcsr_prv(dbcsr_mat%dbcsr, csr_mat)
338 ELSE
339 cpabort("Not yet implemented for DBM.")
340 END IF
341 END SUBROUTINE dbcsr_convert_csr_to_dbcsr
342
343! **************************************************************************************************
344!> \brief ...
345!> \param dbcsr_mat ...
346!> \param csr_mat ...
347! **************************************************************************************************
348 SUBROUTINE dbcsr_convert_dbcsr_to_csr(dbcsr_mat, csr_mat)
349 TYPE(dbcsr_type), INTENT(IN) :: dbcsr_mat
350 TYPE(dbcsr_csr_type), INTENT(INOUT) :: csr_mat
351
352 IF (use_dbcsr_backend) THEN
353 CALL convert_dbcsr_to_csr_prv(dbcsr_mat%dbcsr, csr_mat)
354 ELSE
355 cpabort("Not yet implemented for DBM.")
356 END IF
357 END SUBROUTINE dbcsr_convert_dbcsr_to_csr
358
359! **************************************************************************************************
360!> \brief ...
361!> \param matrix_b ...
362!> \param matrix_a ...
363!> \param name ...
364!> \param keep_sparsity ...
365!> \param keep_imaginary ...
366! **************************************************************************************************
367 SUBROUTINE dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
368 TYPE(dbcsr_type), INTENT(INOUT) :: matrix_b
369 TYPE(dbcsr_type), INTENT(IN) :: matrix_a
370 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name
371 LOGICAL, INTENT(IN), OPTIONAL :: keep_sparsity, keep_imaginary
372
373 IF (use_dbcsr_backend) THEN
374 CALL dbcsr_copy_prv(matrix_b%dbcsr, matrix_a%dbcsr, name=name, &
375 keep_sparsity=keep_sparsity, keep_imaginary=keep_imaginary)
376 ELSE
377 IF (PRESENT(name) .OR. PRESENT(keep_sparsity) .OR. PRESENT(keep_imaginary)) THEN
378 cpabort("Not yet implemented for DBM.")
379 END IF
380 CALL dbm_copy(matrix_b%dbm, matrix_a%dbm)
381 END IF
382 END SUBROUTINE dbcsr_copy
383
384! **************************************************************************************************
385!> \brief ...
386!> \param matrix ...
387!> \param name ...
388!> \param dist ...
389!> \param matrix_type ...
390!> \param row_blk_size ...
391!> \param col_blk_size ...
392!> \param reuse_arrays ...
393!> \param mutable_work ...
394! **************************************************************************************************
395 SUBROUTINE dbcsr_create_new(matrix, name, dist, matrix_type, row_blk_size, col_blk_size, &
396 reuse_arrays, mutable_work)
397 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
398 CHARACTER(len=*), INTENT(IN) :: name
399 TYPE(dbcsr_distribution_type), INTENT(IN) :: dist
400 CHARACTER, INTENT(IN) :: matrix_type
401 INTEGER, DIMENSION(:), INTENT(INOUT), POINTER :: row_blk_size, col_blk_size
402 LOGICAL, INTENT(IN), OPTIONAL :: reuse_arrays, mutable_work
403
404 IF (use_dbcsr_backend) THEN
405 CALL dbcsr_create_prv(matrix=matrix%dbcsr, name=name, dist=dist%dbcsr, &
406 matrix_type=matrix_type, row_blk_size=row_blk_size, &
407 col_blk_size=col_blk_size, nze=0, data_type=dbcsr_type_real_8, &
408 reuse_arrays=reuse_arrays, mutable_work=mutable_work)
409 ELSE
410 cpabort("Not yet implemented for DBM.")
411 END IF
412 END SUBROUTINE dbcsr_create_new
413
414! **************************************************************************************************
415!> \brief ...
416!> \param matrix ...
417!> \param name ...
418!> \param template ...
419!> \param dist ...
420!> \param matrix_type ...
421!> \param row_blk_size ...
422!> \param col_blk_size ...
423!> \param reuse_arrays ...
424!> \param mutable_work ...
425! **************************************************************************************************
426 SUBROUTINE dbcsr_create_template(matrix, name, template, dist, matrix_type, &
427 row_blk_size, col_blk_size, reuse_arrays, mutable_work)
428 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
429 CHARACTER(len=*), INTENT(IN), OPTIONAL :: name
430 TYPE(dbcsr_type), INTENT(IN) :: template
431 TYPE(dbcsr_distribution_type), INTENT(IN), &
432 OPTIONAL :: dist
433 CHARACTER, INTENT(IN), OPTIONAL :: matrix_type
434 INTEGER, DIMENSION(:), INTENT(INOUT), OPTIONAL, &
435 POINTER :: row_blk_size, col_blk_size
436 LOGICAL, INTENT(IN), OPTIONAL :: reuse_arrays, mutable_work
437
438 IF (use_dbcsr_backend) THEN
439 IF (PRESENT(dist)) THEN
440 CALL dbcsr_create_prv(matrix=matrix%dbcsr, name=name, template=template%dbcsr, &
441 dist=dist%dbcsr, matrix_type=matrix_type, &
442 row_blk_size=row_blk_size, col_blk_size=col_blk_size, &
443 nze=0, data_type=dbcsr_type_real_8, reuse_arrays=reuse_arrays, &
444 mutable_work=mutable_work)
445 ELSE
446 CALL dbcsr_create_prv(matrix=matrix%dbcsr, name=name, template=template%dbcsr, &
447 matrix_type=matrix_type, &
448 row_blk_size=row_blk_size, col_blk_size=col_blk_size, &
449 nze=0, data_type=dbcsr_type_real_8, reuse_arrays=reuse_arrays, &
450 mutable_work=mutable_work)
451 END IF
452 ELSE
453 cpabort("Not yet implemented for DBM.")
454 END IF
455 END SUBROUTINE dbcsr_create_template
456
457! **************************************************************************************************
458!> \brief ...
459!> \param dbcsr_mat ...
460!> \param csr_mat ...
461!> \param dist_format ...
462!> \param csr_sparsity ...
463!> \param numnodes ...
464! **************************************************************************************************
465 SUBROUTINE dbcsr_csr_create_from_dbcsr(dbcsr_mat, csr_mat, dist_format, csr_sparsity, numnodes)
466
467 TYPE(dbcsr_type), INTENT(IN) :: dbcsr_mat
468 TYPE(dbcsr_csr_type), INTENT(OUT) :: csr_mat
469 INTEGER :: dist_format
470 TYPE(dbcsr_type), INTENT(IN), OPTIONAL :: csr_sparsity
471 INTEGER, INTENT(IN), OPTIONAL :: numnodes
472
473 IF (use_dbcsr_backend) THEN
474 IF (PRESENT(csr_sparsity)) THEN
475 CALL dbcsr_csr_create_from_dbcsr_prv(dbcsr_mat%dbcsr, csr_mat, dist_format, &
476 csr_sparsity%dbcsr, numnodes)
477 ELSE
478 CALL dbcsr_csr_create_from_dbcsr_prv(dbcsr_mat%dbcsr, csr_mat, &
479 dist_format, numnodes=numnodes)
480 END IF
481 ELSE
482 cpabort("Not yet implemented for DBM.")
483 END IF
484 END SUBROUTINE dbcsr_csr_create_from_dbcsr
485
486! **************************************************************************************************
487!> \brief Combines csr_create_from_dbcsr and convert_dbcsr_to_csr to produce a complex CSR matrix.
488!> \param rmatrix Real part of the matrix.
489!> \param imatrix Imaginary part of the matrix.
490!> \param csr_mat The resulting CSR matrix.
491!> \param dist_format ...
492! **************************************************************************************************
493 SUBROUTINE dbcsr_csr_create_and_convert_complex(rmatrix, imatrix, csr_mat, dist_format)
494 TYPE(dbcsr_type), INTENT(IN) :: rmatrix, imatrix
495 TYPE(dbcsr_csr_type), INTENT(INOUT) :: csr_mat
496 INTEGER :: dist_format
497
498 COMPLEX(KIND=dp), PARAMETER :: ione = cmplx(0.0_dp, 1.0_dp, kind=dp), &
499 rone = cmplx(1.0_dp, 0.0_dp, kind=dp)
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, rone, ione)
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! **************************************************************************************************
966 SUBROUTINE dbcsr_iterator_next_block(iterator, row, column, block, &
967 block_number_argument_has_been_removed, &
968 row_size, col_size, &
969 row_offset, col_offset)
970 TYPE(dbcsr_iterator_type), INTENT(INOUT) :: iterator
971 INTEGER, INTENT(OUT), OPTIONAL :: row, column
972 REAL(kind=dp), DIMENSION(:, :), OPTIONAL, POINTER :: block
973 LOGICAL, OPTIONAL :: block_number_argument_has_been_removed
974 INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size, row_offset, &
975 col_offset
976
977 INTEGER :: my_column, my_row
978 REAL(kind=dp), DIMENSION(:, :), POINTER :: my_block
979
980 cpassert(.NOT. PRESENT(block_number_argument_has_been_removed))
981
982 IF (use_dbcsr_backend) THEN
983 CALL dbcsr_iterator_next_block_prv(iterator%dbcsr, row=my_row, column=my_column, &
984 block=my_block, row_size=row_size, col_size=col_size, &
985 row_offset=row_offset, col_offset=col_offset)
986 IF (PRESENT(block)) block => my_block
987 IF (PRESENT(row)) row = my_row
988 IF (PRESENT(column)) column = my_column
989 ELSE
990 cpabort("Not yet implemented for DBM.")
991 END IF
992 END SUBROUTINE dbcsr_iterator_next_block
993
994! **************************************************************************************************
995!> \brief ...
996!> \param iterator ...
997!> \param matrix ...
998!> \param shared ...
999!> \param dynamic ...
1000!> \param dynamic_byrows ...
1001! **************************************************************************************************
1002 SUBROUTINE dbcsr_iterator_start(iterator, matrix, shared, dynamic, dynamic_byrows)
1003 TYPE(dbcsr_iterator_type), INTENT(OUT) :: iterator
1004 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1005 LOGICAL, INTENT(IN), OPTIONAL :: shared, dynamic, dynamic_byrows
1006
1007 IF (use_dbcsr_backend) THEN
1008 CALL dbcsr_iterator_start_prv(iterator%dbcsr, matrix%dbcsr, shared, dynamic, dynamic_byrows)
1009 ELSE
1010 cpabort("Not yet implemented for DBM.")
1011 END IF
1012 END SUBROUTINE dbcsr_iterator_start
1013
1014! **************************************************************************************************
1015!> \brief Like dbcsr_iterator_start() but with matrix being INTENT(IN).
1016!> When invoking this routine, the caller promises not to modify the returned blocks.
1017!> \param iterator ...
1018!> \param matrix ...
1019!> \param shared ...
1020!> \param dynamic ...
1021!> \param dynamic_byrows ...
1022! **************************************************************************************************
1023 SUBROUTINE dbcsr_iterator_readonly_start(iterator, matrix, shared, dynamic, dynamic_byrows)
1024 TYPE(dbcsr_iterator_type), INTENT(OUT) :: iterator
1025 TYPE(dbcsr_type), INTENT(IN) :: matrix
1026 LOGICAL, INTENT(IN), OPTIONAL :: shared, dynamic, dynamic_byrows
1027
1028 IF (use_dbcsr_backend) THEN
1029 CALL dbcsr_iterator_start_prv(iterator%dbcsr, matrix%dbcsr, shared, dynamic, &
1030 dynamic_byrows, read_only=.true.)
1031 ELSE
1032 cpabort("Not yet implemented for DBM.")
1033 END IF
1034 END SUBROUTINE dbcsr_iterator_readonly_start
1035
1036! **************************************************************************************************
1037!> \brief ...
1038!> \param iterator ...
1039! **************************************************************************************************
1040 SUBROUTINE dbcsr_iterator_stop(iterator)
1041 TYPE(dbcsr_iterator_type), INTENT(INOUT) :: iterator
1042
1043 IF (use_dbcsr_backend) THEN
1044 CALL dbcsr_iterator_stop_prv(iterator%dbcsr)
1045 ELSE
1046 cpabort("Not yet implemented for DBM.")
1047 END IF
1048 END SUBROUTINE dbcsr_iterator_stop
1049
1050! **************************************************************************************************
1051!> \brief ...
1052!> \param dist ...
1053! **************************************************************************************************
1054 SUBROUTINE dbcsr_mp_grid_setup(dist)
1055 TYPE(dbcsr_distribution_type), INTENT(INOUT) :: dist
1056
1057 IF (use_dbcsr_backend) THEN
1058 CALL dbcsr_mp_grid_setup_prv(dist%dbcsr)
1059 ELSE
1060 cpabort("Not yet implemented for DBM.")
1061 END IF
1062 END SUBROUTINE dbcsr_mp_grid_setup
1063
1064! **************************************************************************************************
1065!> \brief ...
1066!> \param transa ...
1067!> \param transb ...
1068!> \param alpha ...
1069!> \param matrix_a ...
1070!> \param matrix_b ...
1071!> \param beta ...
1072!> \param matrix_c ...
1073!> \param first_row ...
1074!> \param last_row ...
1075!> \param first_column ...
1076!> \param last_column ...
1077!> \param first_k ...
1078!> \param last_k ...
1079!> \param retain_sparsity ...
1080!> \param filter_eps ...
1081!> \param flop ...
1082! **************************************************************************************************
1083 SUBROUTINE dbcsr_multiply(transa, transb, alpha, matrix_a, matrix_b, beta, &
1084 matrix_c, first_row, last_row, &
1085 first_column, last_column, first_k, last_k, &
1086 retain_sparsity, filter_eps, flop)
1087 CHARACTER(LEN=1), INTENT(IN) :: transa, transb
1088 REAL(kind=dp), INTENT(IN) :: alpha
1089 TYPE(dbcsr_type), INTENT(IN) :: matrix_a, matrix_b
1090 REAL(kind=dp), INTENT(IN) :: beta
1091 TYPE(dbcsr_type), INTENT(INOUT) :: matrix_c
1092 INTEGER, INTENT(IN), OPTIONAL :: first_row, last_row, first_column, &
1093 last_column, first_k, last_k
1094 LOGICAL, INTENT(IN), OPTIONAL :: retain_sparsity
1095 REAL(kind=dp), INTENT(IN), OPTIONAL :: filter_eps
1096 INTEGER(int_8), INTENT(OUT), OPTIONAL :: flop
1097
1098 IF (use_dbcsr_backend) THEN
1099 CALL dbcsr_multiply_prv(transa, transb, alpha, matrix_a%dbcsr, matrix_b%dbcsr, beta, &
1100 matrix_c%dbcsr, first_row, last_row, first_column, last_column, &
1101 first_k, last_k, retain_sparsity, filter_eps=filter_eps, flop=flop)
1102 ELSE
1103 cpabort("Not yet implemented for DBM.")
1104 END IF
1105 END SUBROUTINE dbcsr_multiply
1106
1107! **************************************************************************************************
1108!> \brief ...
1109!> \param matrix ...
1110!> \param row ...
1111!> \param col ...
1112!> \param block ...
1113!> \param summation ...
1114! **************************************************************************************************
1115 SUBROUTINE dbcsr_put_block(matrix, row, col, block, summation)
1116 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1117 INTEGER, INTENT(IN) :: row, col
1118 REAL(kind=dp), DIMENSION(:, :), INTENT(IN) :: block
1119 LOGICAL, INTENT(IN), OPTIONAL :: summation
1120
1121 IF (use_dbcsr_backend) THEN
1122 CALL dbcsr_put_block_prv(matrix%dbcsr, row, col, block, summation=summation)
1123 ELSE
1124 cpabort("Not yet implemented for DBM.")
1125 END IF
1126 END SUBROUTINE dbcsr_put_block
1127
1128! **************************************************************************************************
1129!> \brief ...
1130!> \param matrix ...
1131! **************************************************************************************************
1132 SUBROUTINE dbcsr_release(matrix)
1133 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1134
1135 IF (use_dbcsr_backend) THEN
1136 CALL dbcsr_release_prv(matrix%dbcsr)
1137 ELSE
1138 cpabort("Not yet implemented for DBM.")
1139 END IF
1140 END SUBROUTINE dbcsr_release
1141
1142! **************************************************************************************************
1143!> \brief ...
1144!> \param matrix ...
1145! **************************************************************************************************
1146 SUBROUTINE dbcsr_replicate_all(matrix)
1147 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1148
1149 IF (use_dbcsr_backend) THEN
1150 CALL dbcsr_replicate_all_prv(matrix%dbcsr)
1151 ELSE
1152 cpabort("Not yet implemented for DBM.")
1153 END IF
1154 END SUBROUTINE dbcsr_replicate_all
1155
1156! **************************************************************************************************
1157!> \brief ...
1158!> \param matrix ...
1159!> \param rows ...
1160!> \param cols ...
1161! **************************************************************************************************
1162 SUBROUTINE dbcsr_reserve_blocks(matrix, rows, cols)
1163 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1164 INTEGER, DIMENSION(:), INTENT(IN) :: rows, cols
1165
1166 IF (use_dbcsr_backend) THEN
1167 CALL dbcsr_reserve_blocks_prv(matrix%dbcsr, rows, cols)
1168 ELSE
1169 cpabort("Not yet implemented for DBM.")
1170 END IF
1171 END SUBROUTINE dbcsr_reserve_blocks
1172
1173! **************************************************************************************************
1174!> \brief ...
1175!> \param matrix ...
1176!> \param alpha_scalar ...
1177! **************************************************************************************************
1178 SUBROUTINE dbcsr_scale(matrix, alpha_scalar)
1179 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1180 REAL(kind=dp), INTENT(IN) :: alpha_scalar
1181
1182 IF (use_dbcsr_backend) THEN
1183 CALL dbcsr_scale_prv(matrix%dbcsr, alpha_scalar)
1184 ELSE
1185 CALL dbm_scale(matrix%dbm, alpha_scalar)
1186 END IF
1187 END SUBROUTINE dbcsr_scale
1188
1189! **************************************************************************************************
1190!> \brief ...
1191!> \param matrix ...
1192!> \param alpha ...
1193! **************************************************************************************************
1194 SUBROUTINE dbcsr_set(matrix, alpha)
1195 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1196 REAL(kind=dp), INTENT(IN) :: alpha
1197
1198 IF (use_dbcsr_backend) THEN
1199 CALL dbcsr_set_prv(matrix%dbcsr, alpha)
1200 ELSE
1201 IF (alpha == 0.0_dp) THEN
1202 CALL dbm_zero(matrix%dbm)
1203 ELSE
1204 cpabort("Not yet implemented for DBM.")
1205 END IF
1206 END IF
1207 END SUBROUTINE dbcsr_set
1208
1209! **************************************************************************************************
1210!> \brief ...
1211!> \param matrix ...
1212! **************************************************************************************************
1213 SUBROUTINE dbcsr_sum_replicated(matrix)
1214 TYPE(dbcsr_type), INTENT(inout) :: matrix
1215
1216 IF (use_dbcsr_backend) THEN
1217 CALL dbcsr_sum_replicated_prv(matrix%dbcsr)
1218 ELSE
1219 cpabort("Not yet implemented for DBM.")
1220 END IF
1221 END SUBROUTINE dbcsr_sum_replicated
1222
1223! **************************************************************************************************
1224!> \brief ...
1225!> \param transposed ...
1226!> \param normal ...
1227!> \param shallow_data_copy ...
1228!> \param transpose_distribution ...
1229!> \param use_distribution ...
1230! **************************************************************************************************
1231 SUBROUTINE dbcsr_transposed(transposed, normal, shallow_data_copy, transpose_distribution, &
1232 use_distribution)
1233 TYPE(dbcsr_type), INTENT(INOUT) :: transposed
1234 TYPE(dbcsr_type), INTENT(IN) :: normal
1235 LOGICAL, INTENT(IN), OPTIONAL :: shallow_data_copy, transpose_distribution
1236 TYPE(dbcsr_distribution_type), INTENT(IN), &
1237 OPTIONAL :: use_distribution
1238
1239 IF (use_dbcsr_backend) THEN
1240 IF (PRESENT(use_distribution)) THEN
1241 CALL dbcsr_transposed_prv(transposed%dbcsr, normal%dbcsr, &
1242 shallow_data_copy=shallow_data_copy, &
1243 transpose_distribution=transpose_distribution, &
1244 use_distribution=use_distribution%dbcsr)
1245 ELSE
1246 CALL dbcsr_transposed_prv(transposed%dbcsr, normal%dbcsr, &
1247 shallow_data_copy=shallow_data_copy, &
1248 transpose_distribution=transpose_distribution)
1249 END IF
1250 ELSE
1251 cpabort("Not yet implemented for DBM.")
1252 END IF
1253 END SUBROUTINE dbcsr_transposed
1254
1255! **************************************************************************************************
1256!> \brief ...
1257!> \param matrix ...
1258!> \return ...
1259! **************************************************************************************************
1260 FUNCTION dbcsr_valid_index(matrix) RESULT(valid_index)
1261 TYPE(dbcsr_type), INTENT(IN) :: matrix
1262 LOGICAL :: valid_index
1263
1264 IF (use_dbcsr_backend) THEN
1265 valid_index = dbcsr_valid_index_prv(matrix%dbcsr)
1266 ELSE
1267 valid_index = .true. ! Does not apply to DBM.
1268 END IF
1269 END FUNCTION dbcsr_valid_index
1270
1271! **************************************************************************************************
1272!> \brief ...
1273!> \param matrix ...
1274!> \param verbosity ...
1275!> \param local ...
1276! **************************************************************************************************
1277 SUBROUTINE dbcsr_verify_matrix(matrix, verbosity, local)
1278 TYPE(dbcsr_type), INTENT(IN) :: matrix
1279 INTEGER, INTENT(IN), OPTIONAL :: verbosity
1280 LOGICAL, INTENT(IN), OPTIONAL :: local
1281
1282 IF (use_dbcsr_backend) THEN
1283 CALL dbcsr_verify_matrix_prv(matrix%dbcsr, verbosity, local)
1284 ELSE
1285 ! Does not apply to DBM.
1286 END IF
1287 END SUBROUTINE dbcsr_verify_matrix
1288
1289! **************************************************************************************************
1290!> \brief ...
1291!> \param matrix ...
1292!> \param nblks_guess ...
1293!> \param sizedata_guess ...
1294!> \param n ...
1295!> \param work_mutable ...
1296! **************************************************************************************************
1297 SUBROUTINE dbcsr_work_create(matrix, nblks_guess, sizedata_guess, n, work_mutable)
1298 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1299 INTEGER, INTENT(IN), OPTIONAL :: nblks_guess, sizedata_guess, n
1300 LOGICAL, INTENT(in), OPTIONAL :: work_mutable
1301
1302 IF (use_dbcsr_backend) THEN
1303 CALL dbcsr_work_create_prv(matrix%dbcsr, nblks_guess, sizedata_guess, n, work_mutable)
1304 ELSE
1305 ! Does not apply to DBM.
1306 END IF
1307 END SUBROUTINE dbcsr_work_create
1308
1309! **************************************************************************************************
1310!> \brief ...
1311!> \param matrix_a ...
1312!> \param matrix_b ...
1313!> \param RESULT ...
1314! **************************************************************************************************
1315 SUBROUTINE dbcsr_dot_threadsafe(matrix_a, matrix_b, RESULT)
1316 TYPE(dbcsr_type), INTENT(IN) :: matrix_a, matrix_b
1317 REAL(kind=dp), INTENT(INOUT) :: result
1318
1319 IF (use_dbcsr_backend) THEN
1320 CALL dbcsr_dot_prv(matrix_a%dbcsr, matrix_b%dbcsr, result)
1321 ELSE
1322 cpabort("Not yet implemented for DBM.")
1323 END IF
1324 END SUBROUTINE dbcsr_dot_threadsafe
1325
1326END 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)
...
subroutine, public dbcsr_iterator_next_block(iterator, row, column, block, block_number_argument_has_been_removed, row_size, col_size, row_offset, col_offset)
...
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_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
Interface to the message passing library MPI.