Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : MODULE cp_dbcsr_api
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: &
54 : dbm_add, dbm_clear, dbm_copy, dbm_distribution_obj, dbm_iterator, dbm_redistribute, &
55 : dbm_scale, dbm_type, dbm_zero
56 : USE kinds, ONLY: dp,&
57 : int_8
58 : USE message_passing, ONLY: mp_comm_type
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
74 : PUBLIC :: dbcsr_distribution_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
89 : PUBLIC :: dbcsr_distribution_hold
90 : PUBLIC :: dbcsr_distribution_release
91 : PUBLIC :: dbcsr_distribution_new
92 : PUBLIC :: dbcsr_create
93 : PUBLIC :: dbcsr_init_p
94 : PUBLIC :: dbcsr_release
95 : PUBLIC :: dbcsr_release_p
96 : PUBLIC :: dbcsr_deallocate_matrix
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
107 : PUBLIC :: dbcsr_complete_redistribute
108 : PUBLIC :: dbcsr_reserve_blocks
109 : PUBLIC :: dbcsr_put_block
110 : PUBLIC :: dbcsr_get_block_p
111 : PUBLIC :: dbcsr_get_readonly_block_p
112 : PUBLIC :: dbcsr_clear
113 :
114 : ! iterator
115 : PUBLIC :: dbcsr_iterator_start
116 : PUBLIC :: dbcsr_iterator_readonly_start
117 : PUBLIC :: dbcsr_iterator_stop
118 : PUBLIC :: dbcsr_iterator_blocks_left
119 : PUBLIC :: dbcsr_iterator_next_block
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
129 : PUBLIC :: dbcsr_get_stored_coordinates
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
154 : PUBLIC :: dbcsr_convert_csr_to_dbcsr
155 : PUBLIC :: dbcsr_convert_dbcsr_to_csr
156 : PUBLIC :: dbcsr_csr_create_from_dbcsr
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
163 : PUBLIC :: dbcsr_csr_create_and_convert_complex
164 : PUBLIC :: dbcsr_csr_type_real_8
165 :
166 : ! binary io
167 : PUBLIC :: dbcsr_binary_write
168 : PUBLIC :: dbcsr_binary_read
169 :
170 : TYPE dbcsr_p_type
171 : TYPE(dbcsr_type), POINTER :: matrix => Null()
172 : END TYPE
173 :
174 : TYPE dbcsr_type
175 : PRIVATE
176 : TYPE(dbcsr_type_prv) :: dbcsr = dbcsr_type_prv()
177 : TYPE(dbm_type) :: dbm = dbm_type()
178 : END TYPE dbcsr_type
179 :
180 : TYPE dbcsr_distribution_type
181 : PRIVATE
182 : TYPE(dbcsr_distribution_type_prv) :: dbcsr = dbcsr_distribution_type_prv()
183 : TYPE(dbm_distribution_obj) :: dbm = dbm_distribution_obj()
184 : END TYPE dbcsr_distribution_type
185 :
186 : TYPE dbcsr_iterator_type
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 :
198 : CONTAINS
199 :
200 : ! **************************************************************************************************
201 : !> \brief ...
202 : !> \param matrix ...
203 : ! **************************************************************************************************
204 315195 : SUBROUTINE dbcsr_init_p(matrix)
205 : TYPE(dbcsr_type), POINTER :: matrix
206 :
207 315195 : IF (ASSOCIATED(matrix)) THEN
208 22322 : CALL dbcsr_release(matrix)
209 22322 : DEALLOCATE (matrix)
210 : END IF
211 :
212 315195 : ALLOCATE (matrix)
213 315195 : END SUBROUTINE dbcsr_init_p
214 :
215 : ! **************************************************************************************************
216 : !> \brief ...
217 : !> \param matrix ...
218 : ! **************************************************************************************************
219 220178 : SUBROUTINE dbcsr_release_p(matrix)
220 : TYPE(dbcsr_type), POINTER :: matrix
221 :
222 220178 : IF (ASSOCIATED(matrix)) THEN
223 219478 : CALL dbcsr_release(matrix)
224 219478 : DEALLOCATE (matrix)
225 : END IF
226 220178 : END SUBROUTINE dbcsr_release_p
227 :
228 : ! **************************************************************************************************
229 : !> \brief ...
230 : !> \param matrix ...
231 : ! **************************************************************************************************
232 1330065 : SUBROUTINE dbcsr_deallocate_matrix(matrix)
233 : TYPE(dbcsr_type), POINTER :: matrix
234 :
235 1330065 : CALL dbcsr_release(matrix)
236 1330065 : IF (dbcsr_valid_index(matrix)) &
237 : CALL cp_abort(__LOCATION__, &
238 : 'You should not "deallocate" a referenced matrix. '// &
239 0 : 'Avoid pointers to DBCSR matrices.')
240 1330065 : DEALLOCATE (matrix)
241 1330065 : 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 2029096 : 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 2029096 : 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 2029096 : END SUBROUTINE dbcsr_add
262 :
263 : ! **************************************************************************************************
264 : !> \brief ...
265 : !> \param filepath ...
266 : !> \param distribution ...
267 : !> \param matrix_new ...
268 : ! **************************************************************************************************
269 36 : 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 36 : 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 36 : END SUBROUTINE dbcsr_binary_read
280 :
281 : ! **************************************************************************************************
282 : !> \brief ...
283 : !> \param matrix ...
284 : !> \param filepath ...
285 : ! **************************************************************************************************
286 278 : SUBROUTINE dbcsr_binary_write(matrix, filepath)
287 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
288 : CHARACTER(LEN=*), INTENT(IN) :: filepath
289 :
290 278 : 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 278 : END SUBROUTINE dbcsr_binary_write
296 :
297 : ! **************************************************************************************************
298 : !> \brief ...
299 : !> \param matrix ...
300 : ! **************************************************************************************************
301 110334 : SUBROUTINE dbcsr_clear(matrix)
302 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
303 :
304 110334 : IF (USE_DBCSR_BACKEND) THEN
305 : CALL dbcsr_clear_prv(matrix%dbcsr)
306 : ELSE
307 : CALL dbm_clear(matrix%dbm)
308 : END IF
309 110334 : END SUBROUTINE
310 :
311 : ! **************************************************************************************************
312 : !> \brief ...
313 : !> \param matrix ...
314 : !> \param redist ...
315 : ! **************************************************************************************************
316 2156953 : SUBROUTINE dbcsr_complete_redistribute(matrix, redist)
317 : TYPE(dbcsr_type), INTENT(IN) :: matrix
318 : TYPE(dbcsr_type), INTENT(INOUT) :: redist
319 :
320 2156953 : 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 2156953 : END SUBROUTINE dbcsr_complete_redistribute
326 :
327 : ! **************************************************************************************************
328 : !> \brief ...
329 : !> \param dbcsr_mat ...
330 : !> \param csr_mat ...
331 : ! **************************************************************************************************
332 0 : 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 0 : 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 0 : END SUBROUTINE dbcsr_convert_csr_to_dbcsr
342 :
343 : ! **************************************************************************************************
344 : !> \brief ...
345 : !> \param dbcsr_mat ...
346 : !> \param csr_mat ...
347 : ! **************************************************************************************************
348 142 : 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 142 : 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 142 : 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 3949157 : 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 6900729 : 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 3949157 : 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 4436609 : 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 4436609 : reuse_arrays=reuse_arrays, mutable_work=mutable_work)
409 : ELSE
410 : CPABORT("Not yet implemented for DBM.")
411 : END IF
412 4436609 : 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 2461991 : 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 2461991 : 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 33598 : 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 4728204 : mutable_work=mutable_work)
451 : END IF
452 : ELSE
453 : CPABORT("Not yet implemented for DBM.")
454 : END IF
455 2461991 : 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 142 : 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 142 : IF (PRESENT(csr_sparsity)) THEN
475 : CALL dbcsr_csr_create_from_dbcsr_prv(dbcsr_mat%dbcsr, csr_mat, dist_format, &
476 0 : csr_sparsity%dbcsr, numnodes)
477 : ELSE
478 : CALL dbcsr_csr_create_from_dbcsr_prv(dbcsr_mat%dbcsr, csr_mat, &
479 142 : dist_format, numnodes=numnodes)
480 : END IF
481 : ELSE
482 : CPABORT("Not yet implemented for DBM.")
483 : END IF
484 142 : 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 128 : 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 64 : CALL dbcsr_create_prv(tmp_matrix%dbcsr, template=rmatrix%dbcsr, data_type=dbcsr_type_complex_8)
505 64 : CALL dbcsr_create_prv(cmatrix%dbcsr, template=rmatrix%dbcsr, data_type=dbcsr_type_complex_8)
506 64 : CALL dbcsr_copy_prv(cmatrix%dbcsr, rmatrix%dbcsr)
507 64 : CALL dbcsr_copy_prv(tmp_matrix%dbcsr, imatrix%dbcsr)
508 64 : CALL dbcsr_add_prv(cmatrix%dbcsr, tmp_matrix%dbcsr, rone, ione)
509 64 : CALL dbcsr_release_prv(tmp_matrix%dbcsr)
510 : ! Convert to csr
511 64 : CALL dbcsr_csr_create_from_dbcsr_prv(cmatrix%dbcsr, csr_mat, dist_format)
512 64 : CALL convert_dbcsr_to_csr_prv(cmatrix%dbcsr, csr_mat)
513 64 : CALL dbcsr_release_prv(cmatrix%dbcsr)
514 : ELSE
515 : CPABORT("Not yet implemented for DBM.")
516 : END IF
517 64 : END SUBROUTINE dbcsr_csr_create_and_convert_complex
518 :
519 : ! **************************************************************************************************
520 : !> \brief ...
521 : !> \param matrix_a ...
522 : !> \param matrix_b ...
523 : ! **************************************************************************************************
524 1237168 : 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 1237168 : 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 1237168 : END SUBROUTINE dbcsr_desymmetrize
534 :
535 : ! **************************************************************************************************
536 : !> \brief ...
537 : !> \param matrix ...
538 : ! **************************************************************************************************
539 52992 : SUBROUTINE dbcsr_distribute(matrix)
540 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
541 :
542 52992 : 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 52992 : 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 7041034 : 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 7041034 : pgrid, subgroups_defined, prow_group, pcol_group)
586 : ELSE
587 : CPABORT("Not yet implemented for DBM.")
588 : END IF
589 7041034 : END SUBROUTINE dbcsr_distribution_get
590 :
591 : ! **************************************************************************************************
592 : !> \brief ...
593 : !> \param dist ...
594 : ! **************************************************************************************************
595 912 : SUBROUTINE dbcsr_distribution_hold(dist)
596 : TYPE(dbcsr_distribution_type) :: dist
597 :
598 912 : 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 912 : 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 4067087 : 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 4067087 : IF (PRESENT(template)) THEN
626 : CALL dbcsr_distribution_new_prv(dist%dbcsr, template%dbcsr, group, pgrid, &
627 1925350 : 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 2141737 : reuse_arrays=reuse_arrays)
632 : END IF
633 : ELSE
634 : CPABORT("Not yet implemented for DBM.")
635 : END IF
636 4067087 : END SUBROUTINE dbcsr_distribution_new
637 :
638 : ! **************************************************************************************************
639 : !> \brief ...
640 : !> \param dist ...
641 : ! **************************************************************************************************
642 4067999 : SUBROUTINE dbcsr_distribution_release(dist)
643 : TYPE(dbcsr_distribution_type) :: dist
644 :
645 4067999 : 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 4067999 : END SUBROUTINE dbcsr_distribution_release
651 :
652 : ! **************************************************************************************************
653 : !> \brief ...
654 : !> \param matrix ...
655 : !> \param eps ...
656 : ! **************************************************************************************************
657 577017 : SUBROUTINE dbcsr_filter(matrix, eps)
658 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
659 : REAL(dp), INTENT(IN) :: eps
660 :
661 577017 : 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 577017 : END SUBROUTINE dbcsr_filter
667 :
668 : ! **************************************************************************************************
669 : !> \brief ...
670 : !> \param matrix ...
671 : ! **************************************************************************************************
672 2388687 : SUBROUTINE dbcsr_finalize(matrix)
673 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
674 :
675 2388687 : 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 2388687 : 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 211623716 : 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 211623716 : 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 211623716 : 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 33939434 : 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 33939434 : matrix_p => matrix ! Hacky workaround to shake the INTENT(IN).
735 33939434 : 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 33939434 : END SUBROUTINE dbcsr_get_readonly_block_p
740 :
741 : ! **************************************************************************************************
742 : !> \brief ...
743 : !> \param matrix ...
744 : !> \param lb ...
745 : !> \param ub ...
746 : !> \return ...
747 : ! **************************************************************************************************
748 5324529 : 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 5324529 : 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 5324529 : END FUNCTION dbcsr_get_data_p
759 :
760 : ! **************************************************************************************************
761 : !> \brief ...
762 : !> \param matrix ...
763 : !> \return ...
764 : ! **************************************************************************************************
765 92 : FUNCTION dbcsr_get_data_size(matrix) RESULT(data_size)
766 : TYPE(dbcsr_type), INTENT(IN) :: matrix
767 : INTEGER :: data_size
768 :
769 92 : 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 92 : 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 25391930 : 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 73288729 : group=group_handle)
847 :
848 25391930 : IF (PRESENT(distribution)) distribution%dbcsr = my_distribution
849 25391930 : IF (PRESENT(group)) CALL group%set_handle(group_handle)
850 : ELSE
851 : CPABORT("Not yet implemented for DBM.")
852 : END IF
853 25391930 : END SUBROUTINE dbcsr_get_info
854 :
855 : ! **************************************************************************************************
856 : !> \brief ...
857 : !> \param matrix ...
858 : !> \return ...
859 : ! **************************************************************************************************
860 1232495 : 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 1232495 : matrix_type = dbcsr_get_matrix_type_prv(matrix%dbcsr)
866 : ELSE
867 : CPABORT("Not yet implemented for DBM.")
868 : END IF
869 1232495 : END FUNCTION dbcsr_get_matrix_type
870 :
871 : ! **************************************************************************************************
872 : !> \brief ...
873 : !> \param matrix ...
874 : !> \return ...
875 : ! **************************************************************************************************
876 80596 : FUNCTION dbcsr_get_num_blocks(matrix) RESULT(num_blocks)
877 : TYPE(dbcsr_type), INTENT(IN) :: matrix
878 : INTEGER :: num_blocks
879 :
880 80596 : 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 80596 : END FUNCTION dbcsr_get_num_blocks
886 :
887 : ! **************************************************************************************************
888 : !> \brief ...
889 : !> \param matrix ...
890 : !> \return ...
891 : ! **************************************************************************************************
892 226922 : FUNCTION dbcsr_get_occupation(matrix) RESULT(occupation)
893 : TYPE(dbcsr_type), INTENT(IN) :: matrix
894 : REAL(KIND=dp) :: occupation
895 :
896 226922 : 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 226922 : END FUNCTION dbcsr_get_occupation
902 :
903 : ! **************************************************************************************************
904 : !> \brief ...
905 : !> \param matrix ...
906 : !> \param row ...
907 : !> \param column ...
908 : !> \param processor ...
909 : ! **************************************************************************************************
910 1320745 : 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 1320745 : CALL dbcsr_get_stored_coordinates_prv(matrix%dbcsr, row, column, processor)
917 : ELSE
918 : CPABORT("Not yet implemented for DBM.")
919 : END IF
920 1320745 : END SUBROUTINE dbcsr_get_stored_coordinates
921 :
922 : ! **************************************************************************************************
923 : !> \brief ...
924 : !> \param matrix ...
925 : !> \return ...
926 : ! **************************************************************************************************
927 6858451 : FUNCTION dbcsr_has_symmetry(matrix) RESULT(has_symmetry)
928 : TYPE(dbcsr_type), INTENT(IN) :: matrix
929 : LOGICAL :: has_symmetry
930 :
931 6858451 : 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 6858451 : END FUNCTION dbcsr_has_symmetry
937 :
938 : ! **************************************************************************************************
939 : !> \brief ...
940 : !> \param iterator ...
941 : !> \return ...
942 : ! **************************************************************************************************
943 146948459 : FUNCTION dbcsr_iterator_blocks_left(iterator) RESULT(blocks_left)
944 : TYPE(dbcsr_iterator_type), INTENT(IN) :: iterator
945 : LOGICAL :: blocks_left
946 :
947 146948459 : 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 146948459 : 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 267230710 : 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 133615355 : REAL(kind=dp), DIMENSION(:, :), POINTER :: my_block
979 :
980 0 : 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 133615355 : row_offset=row_offset, col_offset=col_offset)
986 133615355 : IF (PRESENT(block)) block => my_block
987 133615355 : IF (PRESENT(row)) row = my_row
988 133615355 : IF (PRESENT(column)) column = my_column
989 : ELSE
990 : CPABORT("Not yet implemented for DBM.")
991 : END IF
992 133615355 : 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 10080185 : 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 10080185 : 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 10080185 : 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 3589318 : 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 3589318 : dynamic_byrows, read_only=.TRUE.)
1031 : ELSE
1032 : CPABORT("Not yet implemented for DBM.")
1033 : END IF
1034 3589318 : END SUBROUTINE dbcsr_iterator_readonly_start
1035 :
1036 : ! **************************************************************************************************
1037 : !> \brief ...
1038 : !> \param iterator ...
1039 : ! **************************************************************************************************
1040 13669503 : SUBROUTINE dbcsr_iterator_stop(iterator)
1041 : TYPE(dbcsr_iterator_type), INTENT(INOUT) :: iterator
1042 :
1043 13669503 : 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 13669503 : END SUBROUTINE dbcsr_iterator_stop
1049 :
1050 : ! **************************************************************************************************
1051 : !> \brief ...
1052 : !> \param dist ...
1053 : ! **************************************************************************************************
1054 135271 : SUBROUTINE dbcsr_mp_grid_setup(dist)
1055 : TYPE(dbcsr_distribution_type), INTENT(INOUT) :: dist
1056 :
1057 135271 : 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 135271 : 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 3303383 : 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 3303383 : 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 3303383 : 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 850945 : 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 850945 : 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 850945 : END SUBROUTINE dbcsr_put_block
1127 :
1128 : ! **************************************************************************************************
1129 : !> \brief ...
1130 : !> \param matrix ...
1131 : ! **************************************************************************************************
1132 8064446 : SUBROUTINE dbcsr_release(matrix)
1133 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1134 :
1135 8064446 : 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 8064446 : END SUBROUTINE dbcsr_release
1141 :
1142 : ! **************************************************************************************************
1143 : !> \brief ...
1144 : !> \param matrix ...
1145 : ! **************************************************************************************************
1146 101858 : SUBROUTINE dbcsr_replicate_all(matrix)
1147 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1148 :
1149 101858 : 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 101858 : END SUBROUTINE dbcsr_replicate_all
1155 :
1156 : ! **************************************************************************************************
1157 : !> \brief ...
1158 : !> \param matrix ...
1159 : !> \param rows ...
1160 : !> \param cols ...
1161 : ! **************************************************************************************************
1162 3095793 : 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 3095793 : CALL dbcsr_reserve_blocks_prv(matrix%dbcsr, rows, cols)
1168 : ELSE
1169 : CPABORT("Not yet implemented for DBM.")
1170 : END IF
1171 3095793 : END SUBROUTINE dbcsr_reserve_blocks
1172 :
1173 : ! **************************************************************************************************
1174 : !> \brief ...
1175 : !> \param matrix ...
1176 : !> \param alpha_scalar ...
1177 : ! **************************************************************************************************
1178 422323 : SUBROUTINE dbcsr_scale(matrix, alpha_scalar)
1179 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1180 : REAL(kind=dp), INTENT(IN) :: alpha_scalar
1181 :
1182 422323 : 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 422323 : END SUBROUTINE dbcsr_scale
1188 :
1189 : ! **************************************************************************************************
1190 : !> \brief ...
1191 : !> \param matrix ...
1192 : !> \param alpha ...
1193 : ! **************************************************************************************************
1194 4818148 : 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 4818148 : 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 4818148 : END SUBROUTINE dbcsr_set
1208 :
1209 : ! **************************************************************************************************
1210 : !> \brief ...
1211 : !> \param matrix ...
1212 : ! **************************************************************************************************
1213 52992 : SUBROUTINE dbcsr_sum_replicated(matrix)
1214 : TYPE(dbcsr_type), INTENT(inout) :: matrix
1215 :
1216 52992 : 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 52992 : 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 174732 : 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 174732 : 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 90686 : use_distribution=use_distribution%dbcsr)
1245 : ELSE
1246 : CALL dbcsr_transposed_prv(transposed%dbcsr, normal%dbcsr, &
1247 : shallow_data_copy=shallow_data_copy, &
1248 84046 : transpose_distribution=transpose_distribution)
1249 : END IF
1250 : ELSE
1251 : CPABORT("Not yet implemented for DBM.")
1252 : END IF
1253 174732 : END SUBROUTINE dbcsr_transposed
1254 :
1255 : ! **************************************************************************************************
1256 : !> \brief ...
1257 : !> \param matrix ...
1258 : !> \return ...
1259 : ! **************************************************************************************************
1260 1532493 : FUNCTION dbcsr_valid_index(matrix) RESULT(valid_index)
1261 : TYPE(dbcsr_type), INTENT(IN) :: matrix
1262 : LOGICAL :: valid_index
1263 :
1264 1532493 : 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 1532493 : END FUNCTION dbcsr_valid_index
1270 :
1271 : ! **************************************************************************************************
1272 : !> \brief ...
1273 : !> \param matrix ...
1274 : !> \param verbosity ...
1275 : !> \param local ...
1276 : ! **************************************************************************************************
1277 202428 : 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 202428 : 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 202428 : 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 6250 : 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 6250 : 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 6250 : END SUBROUTINE dbcsr_work_create
1308 :
1309 : ! **************************************************************************************************
1310 : !> \brief ...
1311 : !> \param matrix_a ...
1312 : !> \param matrix_b ...
1313 : !> \param RESULT ...
1314 : ! **************************************************************************************************
1315 40945 : 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 40945 : 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 40945 : END SUBROUTINE dbcsr_dot_threadsafe
1325 :
1326 0 : END MODULE cp_dbcsr_api
|