Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
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 mathconstants, ONLY: gaussi,&
59 : z_one
60 : USE message_passing, ONLY: mp_comm_type
61 : #include "../base/base_uses.f90"
62 :
63 : IMPLICIT NONE
64 : PRIVATE
65 :
66 : ! constants
67 : PUBLIC :: dbcsr_type_no_symmetry
68 : PUBLIC :: dbcsr_type_symmetric
69 : PUBLIC :: dbcsr_type_antisymmetric
70 : PUBLIC :: dbcsr_transpose
71 : PUBLIC :: dbcsr_no_transpose
72 :
73 : ! types
74 : PUBLIC :: dbcsr_type
75 : PUBLIC :: dbcsr_p_type
76 : PUBLIC :: dbcsr_distribution_type
77 : PUBLIC :: dbcsr_iterator_type
78 :
79 : ! lib init/finalize
80 : PUBLIC :: dbcsr_clear_mempools
81 : PUBLIC :: dbcsr_init_lib
82 : PUBLIC :: dbcsr_finalize_lib
83 : PUBLIC :: dbcsr_set_config
84 : PUBLIC :: dbcsr_get_default_config
85 : PUBLIC :: dbcsr_print_config
86 : PUBLIC :: dbcsr_reset_randmat_seed
87 : PUBLIC :: dbcsr_mp_grid_setup
88 : PUBLIC :: dbcsr_print_statistics
89 :
90 : ! create / release
91 : PUBLIC :: dbcsr_distribution_hold
92 : PUBLIC :: dbcsr_distribution_release
93 : PUBLIC :: dbcsr_distribution_new
94 : PUBLIC :: dbcsr_create
95 : PUBLIC :: dbcsr_init_p
96 : PUBLIC :: dbcsr_release
97 : PUBLIC :: dbcsr_release_p
98 : PUBLIC :: dbcsr_deallocate_matrix
99 :
100 : ! primitive matrix operations
101 : PUBLIC :: dbcsr_set
102 : PUBLIC :: dbcsr_add
103 : PUBLIC :: dbcsr_scale
104 : PUBLIC :: dbcsr_transposed
105 : PUBLIC :: dbcsr_multiply
106 : PUBLIC :: dbcsr_copy
107 : PUBLIC :: dbcsr_desymmetrize
108 : PUBLIC :: dbcsr_filter
109 : PUBLIC :: dbcsr_complete_redistribute
110 : PUBLIC :: dbcsr_reserve_blocks
111 : PUBLIC :: dbcsr_put_block
112 : PUBLIC :: dbcsr_get_block_p
113 : PUBLIC :: dbcsr_get_readonly_block_p
114 : PUBLIC :: dbcsr_clear
115 :
116 : ! iterator
117 : PUBLIC :: dbcsr_iterator_start
118 : PUBLIC :: dbcsr_iterator_readonly_start
119 : PUBLIC :: dbcsr_iterator_stop
120 : PUBLIC :: dbcsr_iterator_blocks_left
121 : PUBLIC :: dbcsr_iterator_next_block
122 :
123 : ! getters
124 : PUBLIC :: dbcsr_get_info
125 : PUBLIC :: dbcsr_distribution_get
126 : PUBLIC :: dbcsr_get_matrix_type
127 : PUBLIC :: dbcsr_get_occupation
128 : PUBLIC :: dbcsr_get_num_blocks
129 : PUBLIC :: dbcsr_get_data_size
130 : PUBLIC :: dbcsr_has_symmetry
131 : PUBLIC :: dbcsr_get_stored_coordinates
132 : PUBLIC :: dbcsr_valid_index
133 :
134 : ! work operations
135 : PUBLIC :: dbcsr_work_create
136 : PUBLIC :: dbcsr_verify_matrix
137 : PUBLIC :: dbcsr_get_data_p
138 : PUBLIC :: dbcsr_finalize
139 :
140 : ! replication
141 : PUBLIC :: dbcsr_replicate_all
142 : PUBLIC :: dbcsr_sum_replicated
143 : PUBLIC :: dbcsr_distribute
144 :
145 : ! misc
146 : PUBLIC :: dbcsr_distribution_get_num_images
147 : PUBLIC :: dbcsr_convert_offsets_to_sizes
148 : PUBLIC :: dbcsr_convert_sizes_to_offsets
149 : PUBLIC :: dbcsr_run_tests
150 : PUBLIC :: dbcsr_test_mm
151 : PUBLIC :: dbcsr_dot_threadsafe
152 :
153 : ! csr conversion
154 : PUBLIC :: dbcsr_csr_type
155 : PUBLIC :: dbcsr_csr_p_type
156 : PUBLIC :: dbcsr_convert_csr_to_dbcsr
157 : PUBLIC :: dbcsr_convert_dbcsr_to_csr
158 : PUBLIC :: dbcsr_csr_create_from_dbcsr
159 : PUBLIC :: dbcsr_csr_destroy
160 : PUBLIC :: dbcsr_csr_create
161 : PUBLIC :: dbcsr_csr_eqrow_floor_dist
162 : PUBLIC :: dbcsr_csr_dbcsr_blkrow_dist
163 : PUBLIC :: dbcsr_csr_print_sparsity
164 : PUBLIC :: dbcsr_csr_write
165 : PUBLIC :: dbcsr_csr_create_and_convert_complex
166 : PUBLIC :: dbcsr_csr_type_real_8
167 :
168 : ! binary io
169 : PUBLIC :: dbcsr_binary_write
170 : PUBLIC :: dbcsr_binary_read
171 :
172 : TYPE dbcsr_p_type
173 : TYPE(dbcsr_type), POINTER :: matrix => Null()
174 : END TYPE dbcsr_p_type
175 :
176 : TYPE dbcsr_type
177 : PRIVATE
178 : TYPE(dbcsr_type_prv) :: dbcsr = dbcsr_type_prv()
179 : TYPE(dbm_type) :: dbm = dbm_type()
180 : END TYPE dbcsr_type
181 :
182 : TYPE dbcsr_distribution_type
183 : PRIVATE
184 : TYPE(dbcsr_distribution_type_prv) :: dbcsr = dbcsr_distribution_type_prv()
185 : TYPE(dbm_distribution_obj) :: dbm = dbm_distribution_obj()
186 : END TYPE dbcsr_distribution_type
187 :
188 : TYPE dbcsr_iterator_type
189 : PRIVATE
190 : TYPE(dbcsr_iterator_type_prv) :: dbcsr = dbcsr_iterator_type_prv()
191 : TYPE(dbm_iterator) :: dbm = dbm_iterator()
192 : END TYPE dbcsr_iterator_type
193 :
194 : INTERFACE dbcsr_create
195 : MODULE PROCEDURE dbcsr_create_new, dbcsr_create_template
196 : END INTERFACE
197 :
198 : LOGICAL, PARAMETER, PRIVATE :: USE_DBCSR_BACKEND = .TRUE.
199 :
200 : CONTAINS
201 :
202 : ! **************************************************************************************************
203 : !> \brief ...
204 : !> \param matrix ...
205 : ! **************************************************************************************************
206 348423 : SUBROUTINE dbcsr_init_p(matrix)
207 : TYPE(dbcsr_type), POINTER :: matrix
208 :
209 348423 : IF (ASSOCIATED(matrix)) THEN
210 22322 : CALL dbcsr_release(matrix)
211 22322 : DEALLOCATE (matrix)
212 : END IF
213 :
214 348423 : ALLOCATE (matrix)
215 348423 : END SUBROUTINE dbcsr_init_p
216 :
217 : ! **************************************************************************************************
218 : !> \brief ...
219 : !> \param matrix ...
220 : ! **************************************************************************************************
221 242722 : SUBROUTINE dbcsr_release_p(matrix)
222 : TYPE(dbcsr_type), POINTER :: matrix
223 :
224 242722 : IF (ASSOCIATED(matrix)) THEN
225 241746 : CALL dbcsr_release(matrix)
226 241746 : DEALLOCATE (matrix)
227 : END IF
228 242722 : END SUBROUTINE dbcsr_release_p
229 :
230 : ! **************************************************************************************************
231 : !> \brief ...
232 : !> \param matrix ...
233 : ! **************************************************************************************************
234 3082151 : SUBROUTINE dbcsr_deallocate_matrix(matrix)
235 : TYPE(dbcsr_type), POINTER :: matrix
236 :
237 3082151 : CALL dbcsr_release(matrix)
238 3082151 : IF (dbcsr_valid_index(matrix)) THEN
239 : CALL cp_abort(__LOCATION__, &
240 : 'You should not "deallocate" a referenced matrix. '// &
241 0 : 'Avoid pointers to DBCSR matrices.')
242 : END IF
243 3082151 : DEALLOCATE (matrix)
244 3082151 : END SUBROUTINE dbcsr_deallocate_matrix
245 :
246 : ! **************************************************************************************************
247 : !> \brief ...
248 : !> \param matrix_a ...
249 : !> \param matrix_b ...
250 : !> \param alpha_scalar ...
251 : !> \param beta_scalar ...
252 : ! **************************************************************************************************
253 2235862 : SUBROUTINE dbcsr_add(matrix_a, matrix_b, alpha_scalar, beta_scalar)
254 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix_a
255 : TYPE(dbcsr_type), INTENT(IN) :: matrix_b
256 : REAL(kind=dp), INTENT(IN) :: alpha_scalar, beta_scalar
257 :
258 : IF (USE_DBCSR_BACKEND) THEN
259 2235862 : CALL dbcsr_add_prv(matrix_a%dbcsr, matrix_b%dbcsr, alpha_scalar, beta_scalar)
260 : ELSE
261 : IF (alpha_scalar /= 1.0_dp .OR. beta_scalar /= 1.0_dp) CPABORT("Not yet implemented for DBM.")
262 : CALL dbm_add(matrix_a%dbm, matrix_b%dbm)
263 : END IF
264 2235862 : END SUBROUTINE dbcsr_add
265 :
266 : ! **************************************************************************************************
267 : !> \brief ...
268 : !> \param filepath ...
269 : !> \param distribution ...
270 : !> \param matrix_new ...
271 : ! **************************************************************************************************
272 38 : SUBROUTINE dbcsr_binary_read(filepath, distribution, matrix_new)
273 : CHARACTER(len=*), INTENT(IN) :: filepath
274 : TYPE(dbcsr_distribution_type), INTENT(IN) :: distribution
275 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix_new
276 :
277 38 : IF (USE_DBCSR_BACKEND) THEN
278 : CALL dbcsr_binary_read_prv(filepath, distribution%dbcsr, matrix_new%dbcsr)
279 : ELSE
280 : CPABORT("Not yet implemented for DBM.")
281 : END IF
282 38 : END SUBROUTINE dbcsr_binary_read
283 :
284 : ! **************************************************************************************************
285 : !> \brief ...
286 : !> \param matrix ...
287 : !> \param filepath ...
288 : ! **************************************************************************************************
289 278 : SUBROUTINE dbcsr_binary_write(matrix, filepath)
290 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
291 : CHARACTER(LEN=*), INTENT(IN) :: filepath
292 :
293 278 : IF (USE_DBCSR_BACKEND) THEN
294 : CALL dbcsr_binary_write_prv(matrix%dbcsr, filepath)
295 : ELSE
296 : CPABORT("Not yet implemented for DBM.")
297 : END IF
298 278 : END SUBROUTINE dbcsr_binary_write
299 :
300 : ! **************************************************************************************************
301 : !> \brief ...
302 : !> \param matrix ...
303 : ! **************************************************************************************************
304 127208 : SUBROUTINE dbcsr_clear(matrix)
305 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
306 :
307 127208 : IF (USE_DBCSR_BACKEND) THEN
308 : CALL dbcsr_clear_prv(matrix%dbcsr)
309 : ELSE
310 : CALL dbm_clear(matrix%dbm)
311 : END IF
312 127208 : END SUBROUTINE dbcsr_clear
313 :
314 : ! **************************************************************************************************
315 : !> \brief ...
316 : !> \param matrix ...
317 : !> \param redist ...
318 : ! **************************************************************************************************
319 3067228 : SUBROUTINE dbcsr_complete_redistribute(matrix, redist)
320 : TYPE(dbcsr_type), INTENT(IN) :: matrix
321 : TYPE(dbcsr_type), INTENT(INOUT) :: redist
322 :
323 3067228 : IF (USE_DBCSR_BACKEND) THEN
324 : CALL dbcsr_complete_redistribute_prv(matrix%dbcsr, redist%dbcsr)
325 : ELSE
326 : CALL dbm_redistribute(matrix%dbm, redist%dbm)
327 : END IF
328 3067228 : END SUBROUTINE dbcsr_complete_redistribute
329 :
330 : ! **************************************************************************************************
331 : !> \brief ...
332 : !> \param dbcsr_mat ...
333 : !> \param csr_mat ...
334 : ! **************************************************************************************************
335 0 : SUBROUTINE dbcsr_convert_csr_to_dbcsr(dbcsr_mat, csr_mat)
336 : TYPE(dbcsr_type), INTENT(INOUT) :: dbcsr_mat
337 : TYPE(dbcsr_csr_type), INTENT(INOUT) :: csr_mat
338 :
339 0 : IF (USE_DBCSR_BACKEND) THEN
340 : CALL convert_csr_to_dbcsr_prv(dbcsr_mat%dbcsr, csr_mat)
341 : ELSE
342 : CPABORT("Not yet implemented for DBM.")
343 : END IF
344 0 : END SUBROUTINE dbcsr_convert_csr_to_dbcsr
345 :
346 : ! **************************************************************************************************
347 : !> \brief ...
348 : !> \param dbcsr_mat ...
349 : !> \param csr_mat ...
350 : ! **************************************************************************************************
351 206 : SUBROUTINE dbcsr_convert_dbcsr_to_csr(dbcsr_mat, csr_mat)
352 : TYPE(dbcsr_type), INTENT(IN) :: dbcsr_mat
353 : TYPE(dbcsr_csr_type), INTENT(INOUT) :: csr_mat
354 :
355 206 : IF (USE_DBCSR_BACKEND) THEN
356 : CALL convert_dbcsr_to_csr_prv(dbcsr_mat%dbcsr, csr_mat)
357 : ELSE
358 : CPABORT("Not yet implemented for DBM.")
359 : END IF
360 206 : END SUBROUTINE dbcsr_convert_dbcsr_to_csr
361 :
362 : ! **************************************************************************************************
363 : !> \brief ...
364 : !> \param matrix_b ...
365 : !> \param matrix_a ...
366 : !> \param name ...
367 : !> \param keep_sparsity ...
368 : !> \param keep_imaginary ...
369 : ! **************************************************************************************************
370 6891241 : SUBROUTINE dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
371 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix_b
372 : TYPE(dbcsr_type), INTENT(IN) :: matrix_a
373 : CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name
374 : LOGICAL, INTENT(IN), OPTIONAL :: keep_sparsity, keep_imaginary
375 :
376 : IF (USE_DBCSR_BACKEND) THEN
377 : CALL dbcsr_copy_prv(matrix_b%dbcsr, matrix_a%dbcsr, name=name, &
378 11245605 : keep_sparsity=keep_sparsity, keep_imaginary=keep_imaginary)
379 : ELSE
380 : IF (PRESENT(name) .OR. PRESENT(keep_sparsity) .OR. PRESENT(keep_imaginary)) THEN
381 : CPABORT("Not yet implemented for DBM.")
382 : END IF
383 : CALL dbm_copy(matrix_b%dbm, matrix_a%dbm)
384 : END IF
385 6891241 : END SUBROUTINE dbcsr_copy
386 :
387 : ! **************************************************************************************************
388 : !> \brief ...
389 : !> \param matrix ...
390 : !> \param name ...
391 : !> \param dist ...
392 : !> \param matrix_type ...
393 : !> \param row_blk_size ...
394 : !> \param col_blk_size ...
395 : !> \param reuse_arrays ...
396 : !> \param mutable_work ...
397 : ! **************************************************************************************************
398 5931112 : SUBROUTINE dbcsr_create_new(matrix, name, dist, matrix_type, row_blk_size, col_blk_size, &
399 : reuse_arrays, mutable_work)
400 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
401 : CHARACTER(len=*), INTENT(IN) :: name
402 : TYPE(dbcsr_distribution_type), INTENT(IN) :: dist
403 : CHARACTER, INTENT(IN) :: matrix_type
404 : INTEGER, DIMENSION(:), INTENT(INOUT), POINTER :: row_blk_size, col_blk_size
405 : LOGICAL, INTENT(IN), OPTIONAL :: reuse_arrays, mutable_work
406 :
407 : IF (USE_DBCSR_BACKEND) THEN
408 : CALL dbcsr_create_prv(matrix=matrix%dbcsr, name=name, dist=dist%dbcsr, &
409 : matrix_type=matrix_type, row_blk_size=row_blk_size, &
410 : col_blk_size=col_blk_size, nze=0, data_type=dbcsr_type_real_8, &
411 5931112 : reuse_arrays=reuse_arrays, mutable_work=mutable_work)
412 : ELSE
413 : CPABORT("Not yet implemented for DBM.")
414 : END IF
415 5931112 : END SUBROUTINE dbcsr_create_new
416 :
417 : ! **************************************************************************************************
418 : !> \brief ...
419 : !> \param matrix ...
420 : !> \param name ...
421 : !> \param template ...
422 : !> \param dist ...
423 : !> \param matrix_type ...
424 : !> \param row_blk_size ...
425 : !> \param col_blk_size ...
426 : !> \param reuse_arrays ...
427 : !> \param mutable_work ...
428 : ! **************************************************************************************************
429 4617560 : SUBROUTINE dbcsr_create_template(matrix, name, template, dist, matrix_type, &
430 : row_blk_size, col_blk_size, reuse_arrays, mutable_work)
431 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
432 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: name
433 : TYPE(dbcsr_type), INTENT(IN) :: template
434 : TYPE(dbcsr_distribution_type), INTENT(IN), &
435 : OPTIONAL :: dist
436 : CHARACTER, INTENT(IN), OPTIONAL :: matrix_type
437 : INTEGER, DIMENSION(:), INTENT(INOUT), OPTIONAL, &
438 : POINTER :: row_blk_size, col_blk_size
439 : LOGICAL, INTENT(IN), OPTIONAL :: reuse_arrays, mutable_work
440 :
441 : IF (USE_DBCSR_BACKEND) THEN
442 4617560 : IF (PRESENT(dist)) THEN
443 : CALL dbcsr_create_prv(matrix=matrix%dbcsr, name=name, template=template%dbcsr, &
444 : dist=dist%dbcsr, matrix_type=matrix_type, &
445 : row_blk_size=row_blk_size, col_blk_size=col_blk_size, &
446 : nze=0, data_type=dbcsr_type_real_8, reuse_arrays=reuse_arrays, &
447 33664 : mutable_work=mutable_work)
448 : ELSE
449 : CALL dbcsr_create_prv(matrix=matrix%dbcsr, name=name, template=template%dbcsr, &
450 : matrix_type=matrix_type, &
451 : row_blk_size=row_blk_size, col_blk_size=col_blk_size, &
452 : nze=0, data_type=dbcsr_type_real_8, reuse_arrays=reuse_arrays, &
453 8869935 : mutable_work=mutable_work)
454 : END IF
455 : ELSE
456 : CPABORT("Not yet implemented for DBM.")
457 : END IF
458 4617560 : END SUBROUTINE dbcsr_create_template
459 :
460 : ! **************************************************************************************************
461 : !> \brief ...
462 : !> \param dbcsr_mat ...
463 : !> \param csr_mat ...
464 : !> \param dist_format ...
465 : !> \param csr_sparsity ...
466 : !> \param numnodes ...
467 : ! **************************************************************************************************
468 206 : SUBROUTINE dbcsr_csr_create_from_dbcsr(dbcsr_mat, csr_mat, dist_format, csr_sparsity, numnodes)
469 :
470 : TYPE(dbcsr_type), INTENT(IN) :: dbcsr_mat
471 : TYPE(dbcsr_csr_type), INTENT(OUT) :: csr_mat
472 : INTEGER :: dist_format
473 : TYPE(dbcsr_type), INTENT(IN), OPTIONAL :: csr_sparsity
474 : INTEGER, INTENT(IN), OPTIONAL :: numnodes
475 :
476 : IF (USE_DBCSR_BACKEND) THEN
477 206 : IF (PRESENT(csr_sparsity)) THEN
478 : CALL dbcsr_csr_create_from_dbcsr_prv(dbcsr_mat%dbcsr, csr_mat, dist_format, &
479 0 : csr_sparsity%dbcsr, numnodes)
480 : ELSE
481 : CALL dbcsr_csr_create_from_dbcsr_prv(dbcsr_mat%dbcsr, csr_mat, &
482 206 : dist_format, numnodes=numnodes)
483 : END IF
484 : ELSE
485 : CPABORT("Not yet implemented for DBM.")
486 : END IF
487 206 : END SUBROUTINE dbcsr_csr_create_from_dbcsr
488 :
489 : ! **************************************************************************************************
490 : !> \brief Combines csr_create_from_dbcsr and convert_dbcsr_to_csr to produce a complex CSR matrix.
491 : !> \param rmatrix Real part of the matrix.
492 : !> \param imatrix Imaginary part of the matrix.
493 : !> \param csr_mat The resulting CSR matrix.
494 : !> \param dist_format ...
495 : ! **************************************************************************************************
496 128 : SUBROUTINE dbcsr_csr_create_and_convert_complex(rmatrix, imatrix, csr_mat, dist_format)
497 : TYPE(dbcsr_type), INTENT(IN) :: rmatrix, imatrix
498 : TYPE(dbcsr_csr_type), INTENT(INOUT) :: csr_mat
499 : INTEGER :: dist_format
500 :
501 : TYPE(dbcsr_type) :: cmatrix, tmp_matrix
502 :
503 : IF (USE_DBCSR_BACKEND) THEN
504 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, z_one, gaussi)
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 2181235 : 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 2181235 : 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 2181235 : END SUBROUTINE dbcsr_desymmetrize
534 :
535 : ! **************************************************************************************************
536 : !> \brief ...
537 : !> \param matrix ...
538 : ! **************************************************************************************************
539 222996 : SUBROUTINE dbcsr_distribute(matrix)
540 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
541 :
542 222996 : 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 222996 : 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 8215412 : 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 8215412 : pgrid, subgroups_defined, prow_group, pcol_group)
586 : ELSE
587 : CPABORT("Not yet implemented for DBM.")
588 : END IF
589 8215412 : END SUBROUTINE dbcsr_distribution_get
590 :
591 : ! **************************************************************************************************
592 : !> \brief ...
593 : !> \param dist ...
594 : ! **************************************************************************************************
595 1012 : SUBROUTINE dbcsr_distribution_hold(dist)
596 : TYPE(dbcsr_distribution_type) :: dist
597 :
598 1012 : 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 1012 : 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 5228760 : 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 5228760 : IF (PRESENT(template)) THEN
626 : CALL dbcsr_distribution_new_prv(dist%dbcsr, template%dbcsr, group, pgrid, &
627 2175574 : 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 3053186 : reuse_arrays=reuse_arrays)
632 : END IF
633 : ELSE
634 : CPABORT("Not yet implemented for DBM.")
635 : END IF
636 5228760 : END SUBROUTINE dbcsr_distribution_new
637 :
638 : ! **************************************************************************************************
639 : !> \brief ...
640 : !> \param dist ...
641 : ! **************************************************************************************************
642 5229772 : SUBROUTINE dbcsr_distribution_release(dist)
643 : TYPE(dbcsr_distribution_type) :: dist
644 :
645 5229772 : 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 5229772 : END SUBROUTINE dbcsr_distribution_release
651 :
652 : ! **************************************************************************************************
653 : !> \brief ...
654 : !> \param matrix ...
655 : !> \param eps ...
656 : ! **************************************************************************************************
657 1090279 : SUBROUTINE dbcsr_filter(matrix, eps)
658 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
659 : REAL(dp), INTENT(IN) :: eps
660 :
661 1090279 : 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 1090279 : END SUBROUTINE dbcsr_filter
667 :
668 : ! **************************************************************************************************
669 : !> \brief ...
670 : !> \param matrix ...
671 : ! **************************************************************************************************
672 6574756 : SUBROUTINE dbcsr_finalize(matrix)
673 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
674 :
675 6574756 : 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 6574756 : 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 836986191 : 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 836986191 : 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 836986191 : 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 61989294 : 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 61989294 : matrix_p => matrix ! Hacky workaround to shake the INTENT(IN).
735 61989294 : 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 61989294 : END SUBROUTINE dbcsr_get_readonly_block_p
740 :
741 : ! **************************************************************************************************
742 : !> \brief ...
743 : !> \param matrix ...
744 : !> \param lb ...
745 : !> \param ub ...
746 : !> \return ...
747 : ! **************************************************************************************************
748 5648725 : 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 5648725 : 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 5648725 : END FUNCTION dbcsr_get_data_p
759 :
760 : ! **************************************************************************************************
761 : !> \brief ...
762 : !> \param matrix ...
763 : !> \return ...
764 : ! **************************************************************************************************
765 126 : FUNCTION dbcsr_get_data_size(matrix) RESULT(data_size)
766 : TYPE(dbcsr_type), INTENT(IN) :: matrix
767 : INTEGER :: data_size
768 :
769 126 : 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 126 : 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 32588251 : 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 92839909 : group=group_handle)
847 :
848 32588251 : IF (PRESENT(distribution)) distribution%dbcsr = my_distribution
849 32588251 : IF (PRESENT(group)) CALL group%set_handle(group_handle)
850 : ELSE
851 : CPABORT("Not yet implemented for DBM.")
852 : END IF
853 32588251 : END SUBROUTINE dbcsr_get_info
854 :
855 : ! **************************************************************************************************
856 : !> \brief ...
857 : !> \param matrix ...
858 : !> \return ...
859 : ! **************************************************************************************************
860 2913328 : 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 2913328 : matrix_type = dbcsr_get_matrix_type_prv(matrix%dbcsr)
866 : ELSE
867 : CPABORT("Not yet implemented for DBM.")
868 : END IF
869 2913328 : END FUNCTION dbcsr_get_matrix_type
870 :
871 : ! **************************************************************************************************
872 : !> \brief ...
873 : !> \param matrix ...
874 : !> \return ...
875 : ! **************************************************************************************************
876 94691 : FUNCTION dbcsr_get_num_blocks(matrix) RESULT(num_blocks)
877 : TYPE(dbcsr_type), INTENT(IN) :: matrix
878 : INTEGER :: num_blocks
879 :
880 94691 : 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 94691 : END FUNCTION dbcsr_get_num_blocks
886 :
887 : ! **************************************************************************************************
888 : !> \brief ...
889 : !> \param matrix ...
890 : !> \return ...
891 : ! **************************************************************************************************
892 242914 : FUNCTION dbcsr_get_occupation(matrix) RESULT(occupation)
893 : TYPE(dbcsr_type), INTENT(IN) :: matrix
894 : REAL(KIND=dp) :: occupation
895 :
896 242914 : 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 242914 : END FUNCTION dbcsr_get_occupation
902 :
903 : ! **************************************************************************************************
904 : !> \brief ...
905 : !> \param matrix ...
906 : !> \param row ...
907 : !> \param column ...
908 : !> \param processor ...
909 : ! **************************************************************************************************
910 2719657 : 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 2719657 : CALL dbcsr_get_stored_coordinates_prv(matrix%dbcsr, row, column, processor)
917 : ELSE
918 : CPABORT("Not yet implemented for DBM.")
919 : END IF
920 2719657 : END SUBROUTINE dbcsr_get_stored_coordinates
921 :
922 : ! **************************************************************************************************
923 : !> \brief ...
924 : !> \param matrix ...
925 : !> \return ...
926 : ! **************************************************************************************************
927 14151983 : FUNCTION dbcsr_has_symmetry(matrix) RESULT(has_symmetry)
928 : TYPE(dbcsr_type), INTENT(IN) :: matrix
929 : LOGICAL :: has_symmetry
930 :
931 14151983 : 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 14151983 : END FUNCTION dbcsr_has_symmetry
937 :
938 : ! **************************************************************************************************
939 : !> \brief ...
940 : !> \param iterator ...
941 : !> \return ...
942 : ! **************************************************************************************************
943 277032568 : FUNCTION dbcsr_iterator_blocks_left(iterator) RESULT(blocks_left)
944 : TYPE(dbcsr_iterator_type), INTENT(IN) :: iterator
945 : LOGICAL :: blocks_left
946 :
947 277032568 : 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 277032568 : END FUNCTION dbcsr_iterator_blocks_left
953 :
954 : ! **************************************************************************************************
955 : !> \brief ...
956 : !> \param iterator ...
957 : !> \param row ...
958 : !> \param column ...
959 : !> \param block ...
960 : !> \param block_number_argument_has_been_removed ...
961 : !> \param row_size ...
962 : !> \param col_size ...
963 : !> \param row_offset ...
964 : !> \param col_offset ...
965 : !> \param transposed ...
966 : ! **************************************************************************************************
967 250850218 : SUBROUTINE dbcsr_iterator_next_block(iterator, row, column, block, &
968 : block_number_argument_has_been_removed, &
969 : row_size, col_size, &
970 : row_offset, col_offset, transposed)
971 : TYPE(dbcsr_iterator_type), INTENT(INOUT) :: iterator
972 : INTEGER, INTENT(OUT), OPTIONAL :: row, column
973 : REAL(kind=dp), DIMENSION(:, :), OPTIONAL, POINTER :: block
974 : LOGICAL, OPTIONAL :: block_number_argument_has_been_removed
975 : INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size, row_offset, &
976 : col_offset
977 : LOGICAL, INTENT(OUT), OPTIONAL :: transposed
978 :
979 : INTEGER :: my_column, my_row
980 250850218 : REAL(kind=dp), DIMENSION(:, :), POINTER :: my_block
981 :
982 0 : CPASSERT(.NOT. PRESENT(block_number_argument_has_been_removed))
983 :
984 : IF (USE_DBCSR_BACKEND) THEN
985 250850218 : IF (PRESENT(transposed)) THEN
986 : CALL dbcsr_iterator_next_block_prv(iterator%dbcsr, row=my_row, column=my_column, &
987 : block=my_block, row_size=row_size, col_size=col_size, &
988 : row_offset=row_offset, col_offset=col_offset, &
989 0 : transposed=transposed)
990 : ELSE
991 : CALL dbcsr_iterator_next_block_prv(iterator%dbcsr, row=my_row, column=my_column, &
992 : block=my_block, row_size=row_size, col_size=col_size, &
993 250850218 : row_offset=row_offset, col_offset=col_offset)
994 : END IF
995 250850218 : IF (PRESENT(block)) block => my_block
996 250850218 : IF (PRESENT(row)) row = my_row
997 250850218 : IF (PRESENT(column)) column = my_column
998 : ELSE
999 : CPABORT("Not yet implemented for DBM.")
1000 : END IF
1001 250850218 : END SUBROUTINE dbcsr_iterator_next_block
1002 :
1003 : ! **************************************************************************************************
1004 : !> \brief ...
1005 : !> \param iterator ...
1006 : !> \param matrix ...
1007 : !> \param shared ...
1008 : !> \param dynamic ...
1009 : !> \param dynamic_byrows ...
1010 : ! **************************************************************************************************
1011 20014475 : SUBROUTINE dbcsr_iterator_start(iterator, matrix, shared, dynamic, dynamic_byrows)
1012 : TYPE(dbcsr_iterator_type), INTENT(OUT) :: iterator
1013 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1014 : LOGICAL, INTENT(IN), OPTIONAL :: shared, dynamic, dynamic_byrows
1015 :
1016 20014475 : IF (USE_DBCSR_BACKEND) THEN
1017 : CALL dbcsr_iterator_start_prv(iterator%dbcsr, matrix%dbcsr, shared, dynamic, dynamic_byrows)
1018 : ELSE
1019 : CPABORT("Not yet implemented for DBM.")
1020 : END IF
1021 20014475 : END SUBROUTINE dbcsr_iterator_start
1022 :
1023 : ! **************************************************************************************************
1024 : !> \brief Like dbcsr_iterator_start() but with matrix being INTENT(IN).
1025 : !> When invoking this routine, the caller promises not to modify the returned blocks.
1026 : !> \param iterator ...
1027 : !> \param matrix ...
1028 : !> \param shared ...
1029 : !> \param dynamic ...
1030 : !> \param dynamic_byrows ...
1031 : ! **************************************************************************************************
1032 6566464 : SUBROUTINE dbcsr_iterator_readonly_start(iterator, matrix, shared, dynamic, dynamic_byrows)
1033 : TYPE(dbcsr_iterator_type), INTENT(OUT) :: iterator
1034 : TYPE(dbcsr_type), INTENT(IN) :: matrix
1035 : LOGICAL, INTENT(IN), OPTIONAL :: shared, dynamic, dynamic_byrows
1036 :
1037 : IF (USE_DBCSR_BACKEND) THEN
1038 : CALL dbcsr_iterator_start_prv(iterator%dbcsr, matrix%dbcsr, shared, dynamic, &
1039 6566464 : dynamic_byrows, read_only=.TRUE.)
1040 : ELSE
1041 : CPABORT("Not yet implemented for DBM.")
1042 : END IF
1043 6566464 : END SUBROUTINE dbcsr_iterator_readonly_start
1044 :
1045 : ! **************************************************************************************************
1046 : !> \brief ...
1047 : !> \param iterator ...
1048 : ! **************************************************************************************************
1049 26580939 : SUBROUTINE dbcsr_iterator_stop(iterator)
1050 : TYPE(dbcsr_iterator_type), INTENT(INOUT) :: iterator
1051 :
1052 26580939 : IF (USE_DBCSR_BACKEND) THEN
1053 : CALL dbcsr_iterator_stop_prv(iterator%dbcsr)
1054 : ELSE
1055 : CPABORT("Not yet implemented for DBM.")
1056 : END IF
1057 26580939 : END SUBROUTINE dbcsr_iterator_stop
1058 :
1059 : ! **************************************************************************************************
1060 : !> \brief ...
1061 : !> \param dist ...
1062 : ! **************************************************************************************************
1063 145343 : SUBROUTINE dbcsr_mp_grid_setup(dist)
1064 : TYPE(dbcsr_distribution_type), INTENT(INOUT) :: dist
1065 :
1066 145343 : IF (USE_DBCSR_BACKEND) THEN
1067 : CALL dbcsr_mp_grid_setup_prv(dist%dbcsr)
1068 : ELSE
1069 : CPABORT("Not yet implemented for DBM.")
1070 : END IF
1071 145343 : END SUBROUTINE dbcsr_mp_grid_setup
1072 :
1073 : ! **************************************************************************************************
1074 : !> \brief ...
1075 : !> \param transa ...
1076 : !> \param transb ...
1077 : !> \param alpha ...
1078 : !> \param matrix_a ...
1079 : !> \param matrix_b ...
1080 : !> \param beta ...
1081 : !> \param matrix_c ...
1082 : !> \param first_row ...
1083 : !> \param last_row ...
1084 : !> \param first_column ...
1085 : !> \param last_column ...
1086 : !> \param first_k ...
1087 : !> \param last_k ...
1088 : !> \param retain_sparsity ...
1089 : !> \param filter_eps ...
1090 : !> \param flop ...
1091 : ! **************************************************************************************************
1092 3613680 : SUBROUTINE dbcsr_multiply(transa, transb, alpha, matrix_a, matrix_b, beta, &
1093 : matrix_c, first_row, last_row, &
1094 : first_column, last_column, first_k, last_k, &
1095 : retain_sparsity, filter_eps, flop)
1096 : CHARACTER(LEN=1), INTENT(IN) :: transa, transb
1097 : REAL(kind=dp), INTENT(IN) :: alpha
1098 : TYPE(dbcsr_type), INTENT(IN) :: matrix_a, matrix_b
1099 : REAL(kind=dp), INTENT(IN) :: beta
1100 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix_c
1101 : INTEGER, INTENT(IN), OPTIONAL :: first_row, last_row, first_column, &
1102 : last_column, first_k, last_k
1103 : LOGICAL, INTENT(IN), OPTIONAL :: retain_sparsity
1104 : REAL(kind=dp), INTENT(IN), OPTIONAL :: filter_eps
1105 : INTEGER(int_8), INTENT(OUT), OPTIONAL :: flop
1106 :
1107 : IF (USE_DBCSR_BACKEND) THEN
1108 : CALL dbcsr_multiply_prv(transa, transb, alpha, matrix_a%dbcsr, matrix_b%dbcsr, beta, &
1109 : matrix_c%dbcsr, first_row, last_row, first_column, last_column, &
1110 3613680 : first_k, last_k, retain_sparsity, filter_eps=filter_eps, flop=flop)
1111 : ELSE
1112 : CPABORT("Not yet implemented for DBM.")
1113 : END IF
1114 3613680 : END SUBROUTINE dbcsr_multiply
1115 :
1116 : ! **************************************************************************************************
1117 : !> \brief ...
1118 : !> \param matrix ...
1119 : !> \param row ...
1120 : !> \param col ...
1121 : !> \param block ...
1122 : !> \param summation ...
1123 : ! **************************************************************************************************
1124 945485 : SUBROUTINE dbcsr_put_block(matrix, row, col, block, summation)
1125 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1126 : INTEGER, INTENT(IN) :: row, col
1127 : REAL(kind=dp), DIMENSION(:, :), INTENT(IN) :: block
1128 : LOGICAL, INTENT(IN), OPTIONAL :: summation
1129 :
1130 : IF (USE_DBCSR_BACKEND) THEN
1131 945485 : CALL dbcsr_put_block_prv(matrix%dbcsr, row, col, block, summation=summation)
1132 : ELSE
1133 : CPABORT("Not yet implemented for DBM.")
1134 : END IF
1135 945485 : END SUBROUTINE dbcsr_put_block
1136 :
1137 : ! **************************************************************************************************
1138 : !> \brief ...
1139 : !> \param matrix ...
1140 : ! **************************************************************************************************
1141 11841777 : SUBROUTINE dbcsr_release(matrix)
1142 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1143 :
1144 11841777 : IF (USE_DBCSR_BACKEND) THEN
1145 : CALL dbcsr_release_prv(matrix%dbcsr)
1146 : ELSE
1147 : CPABORT("Not yet implemented for DBM.")
1148 : END IF
1149 11841777 : END SUBROUTINE dbcsr_release
1150 :
1151 : ! **************************************************************************************************
1152 : !> \brief ...
1153 : !> \param matrix ...
1154 : ! **************************************************************************************************
1155 272138 : SUBROUTINE dbcsr_replicate_all(matrix)
1156 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1157 :
1158 272138 : IF (USE_DBCSR_BACKEND) THEN
1159 : CALL dbcsr_replicate_all_prv(matrix%dbcsr)
1160 : ELSE
1161 : CPABORT("Not yet implemented for DBM.")
1162 : END IF
1163 272138 : END SUBROUTINE dbcsr_replicate_all
1164 :
1165 : ! **************************************************************************************************
1166 : !> \brief ...
1167 : !> \param matrix ...
1168 : !> \param rows ...
1169 : !> \param cols ...
1170 : ! **************************************************************************************************
1171 5179864 : SUBROUTINE dbcsr_reserve_blocks(matrix, rows, cols)
1172 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1173 : INTEGER, DIMENSION(:), INTENT(IN) :: rows, cols
1174 :
1175 : IF (USE_DBCSR_BACKEND) THEN
1176 5179864 : CALL dbcsr_reserve_blocks_prv(matrix%dbcsr, rows, cols)
1177 : ELSE
1178 : CPABORT("Not yet implemented for DBM.")
1179 : END IF
1180 5179864 : END SUBROUTINE dbcsr_reserve_blocks
1181 :
1182 : ! **************************************************************************************************
1183 : !> \brief ...
1184 : !> \param matrix ...
1185 : !> \param alpha_scalar ...
1186 : ! **************************************************************************************************
1187 451749 : SUBROUTINE dbcsr_scale(matrix, alpha_scalar)
1188 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1189 : REAL(kind=dp), INTENT(IN) :: alpha_scalar
1190 :
1191 451749 : IF (USE_DBCSR_BACKEND) THEN
1192 : CALL dbcsr_scale_prv(matrix%dbcsr, alpha_scalar)
1193 : ELSE
1194 : CALL dbm_scale(matrix%dbm, alpha_scalar)
1195 : END IF
1196 451749 : END SUBROUTINE dbcsr_scale
1197 :
1198 : ! **************************************************************************************************
1199 : !> \brief ...
1200 : !> \param matrix ...
1201 : !> \param alpha ...
1202 : ! **************************************************************************************************
1203 7867294 : SUBROUTINE dbcsr_set(matrix, alpha)
1204 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1205 : REAL(kind=dp), INTENT(IN) :: alpha
1206 :
1207 : IF (USE_DBCSR_BACKEND) THEN
1208 7867294 : CALL dbcsr_set_prv(matrix%dbcsr, alpha)
1209 : ELSE
1210 : IF (alpha == 0.0_dp) THEN
1211 : CALL dbm_zero(matrix%dbm)
1212 : ELSE
1213 : CPABORT("Not yet implemented for DBM.")
1214 : END IF
1215 : END IF
1216 7867294 : END SUBROUTINE dbcsr_set
1217 :
1218 : ! **************************************************************************************************
1219 : !> \brief ...
1220 : !> \param matrix ...
1221 : ! **************************************************************************************************
1222 53280 : SUBROUTINE dbcsr_sum_replicated(matrix)
1223 : TYPE(dbcsr_type), INTENT(inout) :: matrix
1224 :
1225 53280 : IF (USE_DBCSR_BACKEND) THEN
1226 : CALL dbcsr_sum_replicated_prv(matrix%dbcsr)
1227 : ELSE
1228 : CPABORT("Not yet implemented for DBM.")
1229 : END IF
1230 53280 : END SUBROUTINE dbcsr_sum_replicated
1231 :
1232 : ! **************************************************************************************************
1233 : !> \brief ...
1234 : !> \param transposed ...
1235 : !> \param normal ...
1236 : !> \param shallow_data_copy ...
1237 : !> \param transpose_distribution ...
1238 : !> \param use_distribution ...
1239 : ! **************************************************************************************************
1240 185462 : SUBROUTINE dbcsr_transposed(transposed, normal, shallow_data_copy, transpose_distribution, &
1241 : use_distribution)
1242 : TYPE(dbcsr_type), INTENT(INOUT) :: transposed
1243 : TYPE(dbcsr_type), INTENT(IN) :: normal
1244 : LOGICAL, INTENT(IN), OPTIONAL :: shallow_data_copy, transpose_distribution
1245 : TYPE(dbcsr_distribution_type), INTENT(IN), &
1246 : OPTIONAL :: use_distribution
1247 :
1248 : IF (USE_DBCSR_BACKEND) THEN
1249 185462 : IF (PRESENT(use_distribution)) THEN
1250 : CALL dbcsr_transposed_prv(transposed%dbcsr, normal%dbcsr, &
1251 : shallow_data_copy=shallow_data_copy, &
1252 : transpose_distribution=transpose_distribution, &
1253 100780 : use_distribution=use_distribution%dbcsr)
1254 : ELSE
1255 : CALL dbcsr_transposed_prv(transposed%dbcsr, normal%dbcsr, &
1256 : shallow_data_copy=shallow_data_copy, &
1257 84682 : transpose_distribution=transpose_distribution)
1258 : END IF
1259 : ELSE
1260 : CPABORT("Not yet implemented for DBM.")
1261 : END IF
1262 185462 : END SUBROUTINE dbcsr_transposed
1263 :
1264 : ! **************************************************************************************************
1265 : !> \brief ...
1266 : !> \param matrix ...
1267 : !> \return ...
1268 : ! **************************************************************************************************
1269 3330099 : FUNCTION dbcsr_valid_index(matrix) RESULT(valid_index)
1270 : TYPE(dbcsr_type), INTENT(IN) :: matrix
1271 : LOGICAL :: valid_index
1272 :
1273 3330099 : IF (USE_DBCSR_BACKEND) THEN
1274 : valid_index = dbcsr_valid_index_prv(matrix%dbcsr)
1275 : ELSE
1276 : valid_index = .TRUE. ! Does not apply to DBM.
1277 : END IF
1278 3330099 : END FUNCTION dbcsr_valid_index
1279 :
1280 : ! **************************************************************************************************
1281 : !> \brief ...
1282 : !> \param matrix ...
1283 : !> \param verbosity ...
1284 : !> \param local ...
1285 : ! **************************************************************************************************
1286 247948 : SUBROUTINE dbcsr_verify_matrix(matrix, verbosity, local)
1287 : TYPE(dbcsr_type), INTENT(IN) :: matrix
1288 : INTEGER, INTENT(IN), OPTIONAL :: verbosity
1289 : LOGICAL, INTENT(IN), OPTIONAL :: local
1290 :
1291 247948 : IF (USE_DBCSR_BACKEND) THEN
1292 : CALL dbcsr_verify_matrix_prv(matrix%dbcsr, verbosity, local)
1293 : ELSE
1294 : ! Does not apply to DBM.
1295 : END IF
1296 247948 : END SUBROUTINE dbcsr_verify_matrix
1297 :
1298 : ! **************************************************************************************************
1299 : !> \brief ...
1300 : !> \param matrix ...
1301 : !> \param nblks_guess ...
1302 : !> \param sizedata_guess ...
1303 : !> \param n ...
1304 : !> \param work_mutable ...
1305 : ! **************************************************************************************************
1306 6830 : SUBROUTINE dbcsr_work_create(matrix, nblks_guess, sizedata_guess, n, work_mutable)
1307 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1308 : INTEGER, INTENT(IN), OPTIONAL :: nblks_guess, sizedata_guess, n
1309 : LOGICAL, INTENT(in), OPTIONAL :: work_mutable
1310 :
1311 6830 : IF (USE_DBCSR_BACKEND) THEN
1312 : CALL dbcsr_work_create_prv(matrix%dbcsr, nblks_guess, sizedata_guess, n, work_mutable)
1313 : ELSE
1314 : ! Does not apply to DBM.
1315 : END IF
1316 6830 : END SUBROUTINE dbcsr_work_create
1317 :
1318 : ! **************************************************************************************************
1319 : !> \brief ...
1320 : !> \param matrix_a ...
1321 : !> \param matrix_b ...
1322 : !> \param RESULT ...
1323 : ! **************************************************************************************************
1324 48015 : SUBROUTINE dbcsr_dot_threadsafe(matrix_a, matrix_b, RESULT)
1325 : TYPE(dbcsr_type), INTENT(IN) :: matrix_a, matrix_b
1326 : REAL(kind=dp), INTENT(INOUT) :: result
1327 :
1328 48015 : IF (USE_DBCSR_BACKEND) THEN
1329 : CALL dbcsr_dot_prv(matrix_a%dbcsr, matrix_b%dbcsr, RESULT)
1330 : ELSE
1331 : CPABORT("Not yet implemented for DBM.")
1332 : END IF
1333 48015 : END SUBROUTINE dbcsr_dot_threadsafe
1334 :
1335 0 : END MODULE cp_dbcsr_api
|
