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 338797 : SUBROUTINE dbcsr_init_p(matrix)
207 : TYPE(dbcsr_type), POINTER :: matrix
208 :
209 338797 : IF (ASSOCIATED(matrix)) THEN
210 22322 : CALL dbcsr_release(matrix)
211 22322 : DEALLOCATE (matrix)
212 : END IF
213 :
214 338797 : ALLOCATE (matrix)
215 338797 : END SUBROUTINE dbcsr_init_p
216 :
217 : ! **************************************************************************************************
218 : !> \brief ...
219 : !> \param matrix ...
220 : ! **************************************************************************************************
221 236420 : SUBROUTINE dbcsr_release_p(matrix)
222 : TYPE(dbcsr_type), POINTER :: matrix
223 :
224 236420 : IF (ASSOCIATED(matrix)) THEN
225 235446 : CALL dbcsr_release(matrix)
226 235446 : DEALLOCATE (matrix)
227 : END IF
228 236420 : END SUBROUTINE dbcsr_release_p
229 :
230 : ! **************************************************************************************************
231 : !> \brief ...
232 : !> \param matrix ...
233 : ! **************************************************************************************************
234 2723145 : SUBROUTINE dbcsr_deallocate_matrix(matrix)
235 : TYPE(dbcsr_type), POINTER :: matrix
236 :
237 2723145 : CALL dbcsr_release(matrix)
238 2723145 : IF (dbcsr_valid_index(matrix)) &
239 : CALL cp_abort(__LOCATION__, &
240 : 'You should not "deallocate" a referenced matrix. '// &
241 0 : 'Avoid pointers to DBCSR matrices.')
242 2723145 : DEALLOCATE (matrix)
243 2723145 : END SUBROUTINE dbcsr_deallocate_matrix
244 :
245 : ! **************************************************************************************************
246 : !> \brief ...
247 : !> \param matrix_a ...
248 : !> \param matrix_b ...
249 : !> \param alpha_scalar ...
250 : !> \param beta_scalar ...
251 : ! **************************************************************************************************
252 2201130 : SUBROUTINE dbcsr_add(matrix_a, matrix_b, alpha_scalar, beta_scalar)
253 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix_a
254 : TYPE(dbcsr_type), INTENT(IN) :: matrix_b
255 : REAL(kind=dp), INTENT(IN) :: alpha_scalar, beta_scalar
256 :
257 : IF (USE_DBCSR_BACKEND) THEN
258 2201130 : CALL dbcsr_add_prv(matrix_a%dbcsr, matrix_b%dbcsr, alpha_scalar, beta_scalar)
259 : ELSE
260 : IF (alpha_scalar /= 1.0_dp .OR. beta_scalar /= 1.0_dp) CPABORT("Not yet implemented for DBM.")
261 : CALL dbm_add(matrix_a%dbm, matrix_b%dbm)
262 : END IF
263 2201130 : END SUBROUTINE dbcsr_add
264 :
265 : ! **************************************************************************************************
266 : !> \brief ...
267 : !> \param filepath ...
268 : !> \param distribution ...
269 : !> \param matrix_new ...
270 : ! **************************************************************************************************
271 38 : SUBROUTINE dbcsr_binary_read(filepath, distribution, matrix_new)
272 : CHARACTER(len=*), INTENT(IN) :: filepath
273 : TYPE(dbcsr_distribution_type), INTENT(IN) :: distribution
274 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix_new
275 :
276 38 : IF (USE_DBCSR_BACKEND) THEN
277 : CALL dbcsr_binary_read_prv(filepath, distribution%dbcsr, matrix_new%dbcsr)
278 : ELSE
279 : CPABORT("Not yet implemented for DBM.")
280 : END IF
281 38 : END SUBROUTINE dbcsr_binary_read
282 :
283 : ! **************************************************************************************************
284 : !> \brief ...
285 : !> \param matrix ...
286 : !> \param filepath ...
287 : ! **************************************************************************************************
288 278 : SUBROUTINE dbcsr_binary_write(matrix, filepath)
289 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
290 : CHARACTER(LEN=*), INTENT(IN) :: filepath
291 :
292 278 : IF (USE_DBCSR_BACKEND) THEN
293 : CALL dbcsr_binary_write_prv(matrix%dbcsr, filepath)
294 : ELSE
295 : CPABORT("Not yet implemented for DBM.")
296 : END IF
297 278 : END SUBROUTINE dbcsr_binary_write
298 :
299 : ! **************************************************************************************************
300 : !> \brief ...
301 : !> \param matrix ...
302 : ! **************************************************************************************************
303 124148 : SUBROUTINE dbcsr_clear(matrix)
304 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
305 :
306 124148 : IF (USE_DBCSR_BACKEND) THEN
307 : CALL dbcsr_clear_prv(matrix%dbcsr)
308 : ELSE
309 : CALL dbm_clear(matrix%dbm)
310 : END IF
311 124148 : END SUBROUTINE dbcsr_clear
312 :
313 : ! **************************************************************************************************
314 : !> \brief ...
315 : !> \param matrix ...
316 : !> \param redist ...
317 : ! **************************************************************************************************
318 2903568 : SUBROUTINE dbcsr_complete_redistribute(matrix, redist)
319 : TYPE(dbcsr_type), INTENT(IN) :: matrix
320 : TYPE(dbcsr_type), INTENT(INOUT) :: redist
321 :
322 2903568 : IF (USE_DBCSR_BACKEND) THEN
323 : CALL dbcsr_complete_redistribute_prv(matrix%dbcsr, redist%dbcsr)
324 : ELSE
325 : CALL dbm_redistribute(matrix%dbm, redist%dbm)
326 : END IF
327 2903568 : END SUBROUTINE dbcsr_complete_redistribute
328 :
329 : ! **************************************************************************************************
330 : !> \brief ...
331 : !> \param dbcsr_mat ...
332 : !> \param csr_mat ...
333 : ! **************************************************************************************************
334 0 : SUBROUTINE dbcsr_convert_csr_to_dbcsr(dbcsr_mat, csr_mat)
335 : TYPE(dbcsr_type), INTENT(INOUT) :: dbcsr_mat
336 : TYPE(dbcsr_csr_type), INTENT(INOUT) :: csr_mat
337 :
338 0 : IF (USE_DBCSR_BACKEND) THEN
339 : CALL convert_csr_to_dbcsr_prv(dbcsr_mat%dbcsr, csr_mat)
340 : ELSE
341 : CPABORT("Not yet implemented for DBM.")
342 : END IF
343 0 : END SUBROUTINE dbcsr_convert_csr_to_dbcsr
344 :
345 : ! **************************************************************************************************
346 : !> \brief ...
347 : !> \param dbcsr_mat ...
348 : !> \param csr_mat ...
349 : ! **************************************************************************************************
350 206 : SUBROUTINE dbcsr_convert_dbcsr_to_csr(dbcsr_mat, csr_mat)
351 : TYPE(dbcsr_type), INTENT(IN) :: dbcsr_mat
352 : TYPE(dbcsr_csr_type), INTENT(INOUT) :: csr_mat
353 :
354 206 : IF (USE_DBCSR_BACKEND) THEN
355 : CALL convert_dbcsr_to_csr_prv(dbcsr_mat%dbcsr, csr_mat)
356 : ELSE
357 : CPABORT("Not yet implemented for DBM.")
358 : END IF
359 206 : END SUBROUTINE dbcsr_convert_dbcsr_to_csr
360 :
361 : ! **************************************************************************************************
362 : !> \brief ...
363 : !> \param matrix_b ...
364 : !> \param matrix_a ...
365 : !> \param name ...
366 : !> \param keep_sparsity ...
367 : !> \param keep_imaginary ...
368 : ! **************************************************************************************************
369 6081851 : SUBROUTINE dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
370 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix_b
371 : TYPE(dbcsr_type), INTENT(IN) :: matrix_a
372 : CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name
373 : LOGICAL, INTENT(IN), OPTIONAL :: keep_sparsity, keep_imaginary
374 :
375 : IF (USE_DBCSR_BACKEND) THEN
376 : CALL dbcsr_copy_prv(matrix_b%dbcsr, matrix_a%dbcsr, name=name, &
377 10001317 : keep_sparsity=keep_sparsity, keep_imaginary=keep_imaginary)
378 : ELSE
379 : IF (PRESENT(name) .OR. PRESENT(keep_sparsity) .OR. PRESENT(keep_imaginary)) THEN
380 : CPABORT("Not yet implemented for DBM.")
381 : END IF
382 : CALL dbm_copy(matrix_b%dbm, matrix_a%dbm)
383 : END IF
384 6081851 : END SUBROUTINE dbcsr_copy
385 :
386 : ! **************************************************************************************************
387 : !> \brief ...
388 : !> \param matrix ...
389 : !> \param name ...
390 : !> \param dist ...
391 : !> \param matrix_type ...
392 : !> \param row_blk_size ...
393 : !> \param col_blk_size ...
394 : !> \param reuse_arrays ...
395 : !> \param mutable_work ...
396 : ! **************************************************************************************************
397 5640184 : SUBROUTINE dbcsr_create_new(matrix, name, dist, matrix_type, row_blk_size, col_blk_size, &
398 : reuse_arrays, mutable_work)
399 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
400 : CHARACTER(len=*), INTENT(IN) :: name
401 : TYPE(dbcsr_distribution_type), INTENT(IN) :: dist
402 : CHARACTER, INTENT(IN) :: matrix_type
403 : INTEGER, DIMENSION(:), INTENT(INOUT), POINTER :: row_blk_size, col_blk_size
404 : LOGICAL, INTENT(IN), OPTIONAL :: reuse_arrays, mutable_work
405 :
406 : IF (USE_DBCSR_BACKEND) THEN
407 : CALL dbcsr_create_prv(matrix=matrix%dbcsr, name=name, dist=dist%dbcsr, &
408 : matrix_type=matrix_type, row_blk_size=row_blk_size, &
409 : col_blk_size=col_blk_size, nze=0, data_type=dbcsr_type_real_8, &
410 5640184 : reuse_arrays=reuse_arrays, mutable_work=mutable_work)
411 : ELSE
412 : CPABORT("Not yet implemented for DBM.")
413 : END IF
414 5640184 : END SUBROUTINE dbcsr_create_new
415 :
416 : ! **************************************************************************************************
417 : !> \brief ...
418 : !> \param matrix ...
419 : !> \param name ...
420 : !> \param template ...
421 : !> \param dist ...
422 : !> \param matrix_type ...
423 : !> \param row_blk_size ...
424 : !> \param col_blk_size ...
425 : !> \param reuse_arrays ...
426 : !> \param mutable_work ...
427 : ! **************************************************************************************************
428 4203146 : SUBROUTINE dbcsr_create_template(matrix, name, template, dist, matrix_type, &
429 : row_blk_size, col_blk_size, reuse_arrays, mutable_work)
430 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
431 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: name
432 : TYPE(dbcsr_type), INTENT(IN) :: template
433 : TYPE(dbcsr_distribution_type), INTENT(IN), &
434 : OPTIONAL :: dist
435 : CHARACTER, INTENT(IN), OPTIONAL :: matrix_type
436 : INTEGER, DIMENSION(:), INTENT(INOUT), OPTIONAL, &
437 : POINTER :: row_blk_size, col_blk_size
438 : LOGICAL, INTENT(IN), OPTIONAL :: reuse_arrays, mutable_work
439 :
440 : IF (USE_DBCSR_BACKEND) THEN
441 4203146 : IF (PRESENT(dist)) THEN
442 : CALL dbcsr_create_prv(matrix=matrix%dbcsr, name=name, template=template%dbcsr, &
443 : dist=dist%dbcsr, matrix_type=matrix_type, &
444 : row_blk_size=row_blk_size, col_blk_size=col_blk_size, &
445 : nze=0, data_type=dbcsr_type_real_8, reuse_arrays=reuse_arrays, &
446 33664 : mutable_work=mutable_work)
447 : ELSE
448 : CALL dbcsr_create_prv(matrix=matrix%dbcsr, name=name, template=template%dbcsr, &
449 : matrix_type=matrix_type, &
450 : row_blk_size=row_blk_size, col_blk_size=col_blk_size, &
451 : nze=0, data_type=dbcsr_type_real_8, reuse_arrays=reuse_arrays, &
452 8090379 : mutable_work=mutable_work)
453 : END IF
454 : ELSE
455 : CPABORT("Not yet implemented for DBM.")
456 : END IF
457 4203146 : END SUBROUTINE dbcsr_create_template
458 :
459 : ! **************************************************************************************************
460 : !> \brief ...
461 : !> \param dbcsr_mat ...
462 : !> \param csr_mat ...
463 : !> \param dist_format ...
464 : !> \param csr_sparsity ...
465 : !> \param numnodes ...
466 : ! **************************************************************************************************
467 206 : SUBROUTINE dbcsr_csr_create_from_dbcsr(dbcsr_mat, csr_mat, dist_format, csr_sparsity, numnodes)
468 :
469 : TYPE(dbcsr_type), INTENT(IN) :: dbcsr_mat
470 : TYPE(dbcsr_csr_type), INTENT(OUT) :: csr_mat
471 : INTEGER :: dist_format
472 : TYPE(dbcsr_type), INTENT(IN), OPTIONAL :: csr_sparsity
473 : INTEGER, INTENT(IN), OPTIONAL :: numnodes
474 :
475 : IF (USE_DBCSR_BACKEND) THEN
476 206 : IF (PRESENT(csr_sparsity)) THEN
477 : CALL dbcsr_csr_create_from_dbcsr_prv(dbcsr_mat%dbcsr, csr_mat, dist_format, &
478 0 : csr_sparsity%dbcsr, numnodes)
479 : ELSE
480 : CALL dbcsr_csr_create_from_dbcsr_prv(dbcsr_mat%dbcsr, csr_mat, &
481 206 : dist_format, numnodes=numnodes)
482 : END IF
483 : ELSE
484 : CPABORT("Not yet implemented for DBM.")
485 : END IF
486 206 : END SUBROUTINE dbcsr_csr_create_from_dbcsr
487 :
488 : ! **************************************************************************************************
489 : !> \brief Combines csr_create_from_dbcsr and convert_dbcsr_to_csr to produce a complex CSR matrix.
490 : !> \param rmatrix Real part of the matrix.
491 : !> \param imatrix Imaginary part of the matrix.
492 : !> \param csr_mat The resulting CSR matrix.
493 : !> \param dist_format ...
494 : ! **************************************************************************************************
495 128 : SUBROUTINE dbcsr_csr_create_and_convert_complex(rmatrix, imatrix, csr_mat, dist_format)
496 : TYPE(dbcsr_type), INTENT(IN) :: rmatrix, imatrix
497 : TYPE(dbcsr_csr_type), INTENT(INOUT) :: csr_mat
498 : INTEGER :: dist_format
499 :
500 : TYPE(dbcsr_type) :: cmatrix, tmp_matrix
501 :
502 : IF (USE_DBCSR_BACKEND) THEN
503 64 : CALL dbcsr_create_prv(tmp_matrix%dbcsr, template=rmatrix%dbcsr, data_type=dbcsr_type_complex_8)
504 64 : CALL dbcsr_create_prv(cmatrix%dbcsr, template=rmatrix%dbcsr, data_type=dbcsr_type_complex_8)
505 64 : CALL dbcsr_copy_prv(cmatrix%dbcsr, rmatrix%dbcsr)
506 64 : CALL dbcsr_copy_prv(tmp_matrix%dbcsr, imatrix%dbcsr)
507 64 : CALL dbcsr_add_prv(cmatrix%dbcsr, tmp_matrix%dbcsr, z_one, gaussi)
508 64 : CALL dbcsr_release_prv(tmp_matrix%dbcsr)
509 : ! Convert to csr
510 64 : CALL dbcsr_csr_create_from_dbcsr_prv(cmatrix%dbcsr, csr_mat, dist_format)
511 64 : CALL convert_dbcsr_to_csr_prv(cmatrix%dbcsr, csr_mat)
512 64 : CALL dbcsr_release_prv(cmatrix%dbcsr)
513 : ELSE
514 : CPABORT("Not yet implemented for DBM.")
515 : END IF
516 64 : END SUBROUTINE dbcsr_csr_create_and_convert_complex
517 :
518 : ! **************************************************************************************************
519 : !> \brief ...
520 : !> \param matrix_a ...
521 : !> \param matrix_b ...
522 : ! **************************************************************************************************
523 2051767 : SUBROUTINE dbcsr_desymmetrize(matrix_a, matrix_b)
524 : TYPE(dbcsr_type), INTENT(IN) :: matrix_a
525 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix_b
526 :
527 2051767 : IF (USE_DBCSR_BACKEND) THEN
528 : CALL dbcsr_desymmetrize_prv(matrix_a%dbcsr, matrix_b%dbcsr)
529 : ELSE
530 : CPABORT("Not yet implemented for DBM.")
531 : END IF
532 2051767 : END SUBROUTINE dbcsr_desymmetrize
533 :
534 : ! **************************************************************************************************
535 : !> \brief ...
536 : !> \param matrix ...
537 : ! **************************************************************************************************
538 110150 : SUBROUTINE dbcsr_distribute(matrix)
539 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
540 :
541 110150 : IF (USE_DBCSR_BACKEND) THEN
542 : CALL dbcsr_distribute_prv(matrix%dbcsr)
543 : ELSE
544 : CPABORT("Not yet implemented for DBM.")
545 : END IF
546 110150 : END SUBROUTINE dbcsr_distribute
547 :
548 : ! **************************************************************************************************
549 : !> \brief ...
550 : !> \param dist ...
551 : !> \param row_dist ...
552 : !> \param col_dist ...
553 : !> \param nrows ...
554 : !> \param ncols ...
555 : !> \param has_threads ...
556 : !> \param group ...
557 : !> \param mynode ...
558 : !> \param numnodes ...
559 : !> \param nprows ...
560 : !> \param npcols ...
561 : !> \param myprow ...
562 : !> \param mypcol ...
563 : !> \param pgrid ...
564 : !> \param subgroups_defined ...
565 : !> \param prow_group ...
566 : !> \param pcol_group ...
567 : ! **************************************************************************************************
568 7983916 : SUBROUTINE dbcsr_distribution_get(dist, row_dist, col_dist, nrows, ncols, has_threads, &
569 : group, mynode, numnodes, nprows, npcols, myprow, mypcol, &
570 : pgrid, subgroups_defined, prow_group, pcol_group)
571 : TYPE(dbcsr_distribution_type), INTENT(IN) :: dist
572 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: row_dist, col_dist
573 : INTEGER, INTENT(OUT), OPTIONAL :: nrows, ncols
574 : LOGICAL, INTENT(OUT), OPTIONAL :: has_threads
575 : INTEGER, INTENT(OUT), OPTIONAL :: group, mynode, numnodes, nprows, npcols, &
576 : myprow, mypcol
577 : INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: pgrid
578 : LOGICAL, INTENT(OUT), OPTIONAL :: subgroups_defined
579 : INTEGER, INTENT(OUT), OPTIONAL :: prow_group, pcol_group
580 :
581 : IF (USE_DBCSR_BACKEND) THEN
582 : CALL dbcsr_distribution_get_prv(dist%dbcsr, row_dist, col_dist, nrows, ncols, has_threads, &
583 : group, mynode, numnodes, nprows, npcols, myprow, mypcol, &
584 7983916 : pgrid, subgroups_defined, prow_group, pcol_group)
585 : ELSE
586 : CPABORT("Not yet implemented for DBM.")
587 : END IF
588 7983916 : END SUBROUTINE dbcsr_distribution_get
589 :
590 : ! **************************************************************************************************
591 : !> \brief ...
592 : !> \param dist ...
593 : ! **************************************************************************************************
594 1012 : SUBROUTINE dbcsr_distribution_hold(dist)
595 : TYPE(dbcsr_distribution_type) :: dist
596 :
597 1012 : IF (USE_DBCSR_BACKEND) THEN
598 : CALL dbcsr_distribution_hold_prv(dist%dbcsr)
599 : ELSE
600 : CPABORT("Not yet implemented for DBM.")
601 : END IF
602 1012 : END SUBROUTINE dbcsr_distribution_hold
603 :
604 : ! **************************************************************************************************
605 : !> \brief ...
606 : !> \param dist ...
607 : !> \param template ...
608 : !> \param group ...
609 : !> \param pgrid ...
610 : !> \param row_dist ...
611 : !> \param col_dist ...
612 : !> \param reuse_arrays ...
613 : ! **************************************************************************************************
614 4995168 : SUBROUTINE dbcsr_distribution_new(dist, template, group, pgrid, row_dist, col_dist, reuse_arrays)
615 : TYPE(dbcsr_distribution_type), INTENT(OUT) :: dist
616 : TYPE(dbcsr_distribution_type), INTENT(IN), &
617 : OPTIONAL :: template
618 : INTEGER, INTENT(IN), OPTIONAL :: group
619 : INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: pgrid
620 : INTEGER, DIMENSION(:), INTENT(INOUT), POINTER :: row_dist, col_dist
621 : LOGICAL, INTENT(IN), OPTIONAL :: reuse_arrays
622 :
623 : IF (USE_DBCSR_BACKEND) THEN
624 4995168 : IF (PRESENT(template)) THEN
625 : CALL dbcsr_distribution_new_prv(dist%dbcsr, template%dbcsr, group, pgrid, &
626 2105986 : row_dist, col_dist, reuse_arrays)
627 : ELSE
628 : CALL dbcsr_distribution_new_prv(dist%dbcsr, group=group, pgrid=pgrid, &
629 : row_dist=row_dist, col_dist=col_dist, &
630 2889182 : reuse_arrays=reuse_arrays)
631 : END IF
632 : ELSE
633 : CPABORT("Not yet implemented for DBM.")
634 : END IF
635 4995168 : END SUBROUTINE dbcsr_distribution_new
636 :
637 : ! **************************************************************************************************
638 : !> \brief ...
639 : !> \param dist ...
640 : ! **************************************************************************************************
641 4996180 : SUBROUTINE dbcsr_distribution_release(dist)
642 : TYPE(dbcsr_distribution_type) :: dist
643 :
644 4996180 : IF (USE_DBCSR_BACKEND) THEN
645 : CALL dbcsr_distribution_release_prv(dist%dbcsr)
646 : ELSE
647 : CPABORT("Not yet implemented for DBM.")
648 : END IF
649 4996180 : END SUBROUTINE dbcsr_distribution_release
650 :
651 : ! **************************************************************************************************
652 : !> \brief ...
653 : !> \param matrix ...
654 : !> \param eps ...
655 : ! **************************************************************************************************
656 993621 : SUBROUTINE dbcsr_filter(matrix, eps)
657 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
658 : REAL(dp), INTENT(IN) :: eps
659 :
660 993621 : IF (USE_DBCSR_BACKEND) THEN
661 : CALL dbcsr_filter_prv(matrix%dbcsr, eps)
662 : ELSE
663 : CPABORT("Not yet implemented for DBM.")
664 : END IF
665 993621 : END SUBROUTINE dbcsr_filter
666 :
667 : ! **************************************************************************************************
668 : !> \brief ...
669 : !> \param matrix ...
670 : ! **************************************************************************************************
671 5628672 : SUBROUTINE dbcsr_finalize(matrix)
672 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
673 :
674 5628672 : IF (USE_DBCSR_BACKEND) THEN
675 : CALL dbcsr_finalize_prv(matrix%dbcsr)
676 : ELSE
677 : CPABORT("Not yet implemented for DBM.")
678 : END IF
679 5628672 : END SUBROUTINE dbcsr_finalize
680 :
681 : ! **************************************************************************************************
682 : !> \brief ...
683 : !> \param matrix ...
684 : !> \param row ...
685 : !> \param col ...
686 : !> \param block ...
687 : !> \param found ...
688 : !> \param row_size ...
689 : !> \param col_size ...
690 : ! **************************************************************************************************
691 726740480 : SUBROUTINE dbcsr_get_block_p(matrix, row, col, block, found, row_size, col_size)
692 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
693 : INTEGER, INTENT(IN) :: row, col
694 : REAL(kind=dp), DIMENSION(:, :), POINTER :: block
695 : LOGICAL, INTENT(OUT) :: found
696 : INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size
697 :
698 : IF (USE_DBCSR_BACKEND) THEN
699 726740480 : CALL dbcsr_get_block_p_prv(matrix%dbcsr, row, col, block, found, row_size, col_size)
700 : ELSE
701 : CPABORT("Not yet implemented for DBM.")
702 : END IF
703 726740480 : END SUBROUTINE dbcsr_get_block_p
704 :
705 : ! **************************************************************************************************
706 : !> \brief Like dbcsr_get_block_p() but with matrix being INTENT(IN).
707 : !> When invoking this routine, the caller promises not to modify the returned block.
708 : !> \param matrix ...
709 : !> \param row ...
710 : !> \param col ...
711 : !> \param block ...
712 : !> \param found ...
713 : !> \param row_size ...
714 : !> \param col_size ...
715 : ! **************************************************************************************************
716 51907157 : SUBROUTINE dbcsr_get_readonly_block_p(matrix, row, col, block, found, row_size, col_size)
717 : TYPE(dbcsr_type), INTENT(IN), TARGET :: matrix
718 : INTEGER, INTENT(IN) :: row, col
719 : REAL(kind=dp), DIMENSION(:, :), POINTER :: block
720 : LOGICAL, INTENT(OUT) :: found
721 : INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size
722 :
723 : TYPE(dbcsr_type), POINTER :: matrix_p
724 :
725 : MARK_USED(matrix)
726 : MARK_USED(row)
727 : MARK_USED(col)
728 : MARK_USED(block)
729 : MARK_USED(found)
730 : MARK_USED(row_size)
731 : MARK_USED(col_size)
732 : IF (USE_DBCSR_BACKEND) THEN
733 51907157 : matrix_p => matrix ! Hacky workaround to shake the INTENT(IN).
734 51907157 : CALL dbcsr_get_block_p_prv(matrix_p%dbcsr, row, col, block, found, row_size, col_size)
735 : ELSE
736 : CPABORT("Not yet implemented for DBM.")
737 : END IF
738 51907157 : END SUBROUTINE dbcsr_get_readonly_block_p
739 :
740 : ! **************************************************************************************************
741 : !> \brief ...
742 : !> \param matrix ...
743 : !> \param lb ...
744 : !> \param ub ...
745 : !> \return ...
746 : ! **************************************************************************************************
747 5653671 : FUNCTION dbcsr_get_data_p(matrix, lb, ub) RESULT(res)
748 : TYPE(dbcsr_type), INTENT(IN) :: matrix
749 : INTEGER, INTENT(IN), OPTIONAL :: lb, ub
750 : REAL(kind=dp), DIMENSION(:), POINTER :: res
751 :
752 : IF (USE_DBCSR_BACKEND) THEN
753 5653671 : res => dbcsr_get_data_p_prv(matrix%dbcsr, select_data_type=0.0_dp, lb=lb, ub=ub)
754 : ELSE
755 : CPABORT("Not yet implemented for DBM.")
756 : END IF
757 5653671 : END FUNCTION dbcsr_get_data_p
758 :
759 : ! **************************************************************************************************
760 : !> \brief ...
761 : !> \param matrix ...
762 : !> \return ...
763 : ! **************************************************************************************************
764 92 : FUNCTION dbcsr_get_data_size(matrix) RESULT(data_size)
765 : TYPE(dbcsr_type), INTENT(IN) :: matrix
766 : INTEGER :: data_size
767 :
768 92 : IF (USE_DBCSR_BACKEND) THEN
769 : data_size = dbcsr_get_data_size_prv(matrix%dbcsr)
770 : ELSE
771 : CPABORT("Not yet implemented for DBM.")
772 : END IF
773 92 : END FUNCTION dbcsr_get_data_size
774 :
775 : ! **************************************************************************************************
776 : !> \brief ...
777 : !> \param matrix ...
778 : !> \param nblkrows_total ...
779 : !> \param nblkcols_total ...
780 : !> \param nfullrows_total ...
781 : !> \param nfullcols_total ...
782 : !> \param nblkrows_local ...
783 : !> \param nblkcols_local ...
784 : !> \param nfullrows_local ...
785 : !> \param nfullcols_local ...
786 : !> \param my_prow ...
787 : !> \param my_pcol ...
788 : !> \param local_rows ...
789 : !> \param local_cols ...
790 : !> \param proc_row_dist ...
791 : !> \param proc_col_dist ...
792 : !> \param row_blk_size ...
793 : !> \param col_blk_size ...
794 : !> \param row_blk_offset ...
795 : !> \param col_blk_offset ...
796 : !> \param distribution ...
797 : !> \param name ...
798 : !> \param matrix_type ...
799 : !> \param group ...
800 : ! **************************************************************************************************
801 30901827 : SUBROUTINE dbcsr_get_info(matrix, nblkrows_total, nblkcols_total, &
802 : nfullrows_total, nfullcols_total, nblkrows_local, nblkcols_local, &
803 : nfullrows_local, nfullcols_local, my_prow, my_pcol, &
804 : local_rows, local_cols, proc_row_dist, proc_col_dist, &
805 : row_blk_size, col_blk_size, row_blk_offset, col_blk_offset, &
806 : distribution, name, matrix_type, group)
807 : TYPE(dbcsr_type), INTENT(IN) :: matrix
808 : INTEGER, INTENT(OUT), OPTIONAL :: nblkrows_total, nblkcols_total, nfullrows_total, &
809 : nfullcols_total, nblkrows_local, nblkcols_local, nfullrows_local, nfullcols_local, &
810 : my_prow, my_pcol
811 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: local_rows, local_cols, proc_row_dist, &
812 : proc_col_dist, row_blk_size, col_blk_size, row_blk_offset, col_blk_offset
813 : TYPE(dbcsr_distribution_type), INTENT(OUT), &
814 : OPTIONAL :: distribution
815 : CHARACTER(len=*), INTENT(OUT), OPTIONAL :: name
816 : CHARACTER, INTENT(OUT), OPTIONAL :: matrix_type
817 : TYPE(mp_comm_type), INTENT(OUT), OPTIONAL :: group
818 :
819 : INTEGER :: group_handle
820 : TYPE(dbcsr_distribution_type_prv) :: my_distribution
821 :
822 : IF (USE_DBCSR_BACKEND) THEN
823 : CALL dbcsr_get_info_prv(matrix=matrix%dbcsr, &
824 : nblkrows_total=nblkrows_total, &
825 : nblkcols_total=nblkcols_total, &
826 : nfullrows_total=nfullrows_total, &
827 : nfullcols_total=nfullcols_total, &
828 : nblkrows_local=nblkrows_local, &
829 : nblkcols_local=nblkcols_local, &
830 : nfullrows_local=nfullrows_local, &
831 : nfullcols_local=nfullcols_local, &
832 : my_prow=my_prow, &
833 : my_pcol=my_pcol, &
834 : local_rows=local_rows, &
835 : local_cols=local_cols, &
836 : proc_row_dist=proc_row_dist, &
837 : proc_col_dist=proc_col_dist, &
838 : row_blk_size=row_blk_size, &
839 : col_blk_size=col_blk_size, &
840 : row_blk_offset=row_blk_offset, &
841 : col_blk_offset=col_blk_offset, &
842 : distribution=my_distribution, &
843 : name=name, &
844 : matrix_type=matrix_type, &
845 88224923 : group=group_handle)
846 :
847 30901827 : IF (PRESENT(distribution)) distribution%dbcsr = my_distribution
848 30901827 : IF (PRESENT(group)) CALL group%set_handle(group_handle)
849 : ELSE
850 : CPABORT("Not yet implemented for DBM.")
851 : END IF
852 30901827 : END SUBROUTINE dbcsr_get_info
853 :
854 : ! **************************************************************************************************
855 : !> \brief ...
856 : !> \param matrix ...
857 : !> \return ...
858 : ! **************************************************************************************************
859 2545160 : FUNCTION dbcsr_get_matrix_type(matrix) RESULT(matrix_type)
860 : TYPE(dbcsr_type), INTENT(IN) :: matrix
861 : CHARACTER :: matrix_type
862 :
863 : IF (USE_DBCSR_BACKEND) THEN
864 2545160 : matrix_type = dbcsr_get_matrix_type_prv(matrix%dbcsr)
865 : ELSE
866 : CPABORT("Not yet implemented for DBM.")
867 : END IF
868 2545160 : END FUNCTION dbcsr_get_matrix_type
869 :
870 : ! **************************************************************************************************
871 : !> \brief ...
872 : !> \param matrix ...
873 : !> \return ...
874 : ! **************************************************************************************************
875 92303 : FUNCTION dbcsr_get_num_blocks(matrix) RESULT(num_blocks)
876 : TYPE(dbcsr_type), INTENT(IN) :: matrix
877 : INTEGER :: num_blocks
878 :
879 92303 : IF (USE_DBCSR_BACKEND) THEN
880 : num_blocks = dbcsr_get_num_blocks_prv(matrix%dbcsr)
881 : ELSE
882 : CPABORT("Not yet implemented for DBM.")
883 : END IF
884 92303 : END FUNCTION dbcsr_get_num_blocks
885 :
886 : ! **************************************************************************************************
887 : !> \brief ...
888 : !> \param matrix ...
889 : !> \return ...
890 : ! **************************************************************************************************
891 246090 : FUNCTION dbcsr_get_occupation(matrix) RESULT(occupation)
892 : TYPE(dbcsr_type), INTENT(IN) :: matrix
893 : REAL(KIND=dp) :: occupation
894 :
895 246090 : IF (USE_DBCSR_BACKEND) THEN
896 : occupation = dbcsr_get_occupation_prv(matrix%dbcsr)
897 : ELSE
898 : CPABORT("Not yet implemented for DBM.")
899 : END IF
900 246090 : END FUNCTION dbcsr_get_occupation
901 :
902 : ! **************************************************************************************************
903 : !> \brief ...
904 : !> \param matrix ...
905 : !> \param row ...
906 : !> \param column ...
907 : !> \param processor ...
908 : ! **************************************************************************************************
909 2035704 : SUBROUTINE dbcsr_get_stored_coordinates(matrix, row, column, processor)
910 : TYPE(dbcsr_type), INTENT(IN) :: matrix
911 : INTEGER, INTENT(IN) :: row, column
912 : INTEGER, INTENT(OUT) :: processor
913 :
914 : IF (USE_DBCSR_BACKEND) THEN
915 2035704 : CALL dbcsr_get_stored_coordinates_prv(matrix%dbcsr, row, column, processor)
916 : ELSE
917 : CPABORT("Not yet implemented for DBM.")
918 : END IF
919 2035704 : END SUBROUTINE dbcsr_get_stored_coordinates
920 :
921 : ! **************************************************************************************************
922 : !> \brief ...
923 : !> \param matrix ...
924 : !> \return ...
925 : ! **************************************************************************************************
926 11796453 : FUNCTION dbcsr_has_symmetry(matrix) RESULT(has_symmetry)
927 : TYPE(dbcsr_type), INTENT(IN) :: matrix
928 : LOGICAL :: has_symmetry
929 :
930 11796453 : IF (USE_DBCSR_BACKEND) THEN
931 : has_symmetry = dbcsr_has_symmetry_prv(matrix%dbcsr)
932 : ELSE
933 : CPABORT("Not yet implemented for DBM.")
934 : END IF
935 11796453 : END FUNCTION dbcsr_has_symmetry
936 :
937 : ! **************************************************************************************************
938 : !> \brief ...
939 : !> \param iterator ...
940 : !> \return ...
941 : ! **************************************************************************************************
942 233896168 : FUNCTION dbcsr_iterator_blocks_left(iterator) RESULT(blocks_left)
943 : TYPE(dbcsr_iterator_type), INTENT(IN) :: iterator
944 : LOGICAL :: blocks_left
945 :
946 233896168 : IF (USE_DBCSR_BACKEND) THEN
947 : blocks_left = dbcsr_iterator_blocks_left_prv(iterator%dbcsr)
948 : ELSE
949 : CPABORT("Not yet implemented for DBM.")
950 : END IF
951 233896168 : END FUNCTION dbcsr_iterator_blocks_left
952 :
953 : ! **************************************************************************************************
954 : !> \brief ...
955 : !> \param iterator ...
956 : !> \param row ...
957 : !> \param column ...
958 : !> \param block ...
959 : !> \param block_number_argument_has_been_removed ...
960 : !> \param row_size ...
961 : !> \param col_size ...
962 : !> \param row_offset ...
963 : !> \param col_offset ...
964 : !> \param transposed ...
965 : ! **************************************************************************************************
966 211206794 : 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, transposed)
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 : LOGICAL, INTENT(OUT), OPTIONAL :: transposed
977 :
978 : INTEGER :: my_column, my_row
979 211206794 : REAL(kind=dp), DIMENSION(:, :), POINTER :: my_block
980 :
981 0 : CPASSERT(.NOT. PRESENT(block_number_argument_has_been_removed))
982 :
983 : IF (USE_DBCSR_BACKEND) THEN
984 211206794 : IF (PRESENT(transposed)) THEN
985 : CALL dbcsr_iterator_next_block_prv(iterator%dbcsr, row=my_row, column=my_column, &
986 : block=my_block, row_size=row_size, col_size=col_size, &
987 : row_offset=row_offset, col_offset=col_offset, &
988 1424 : transposed=transposed)
989 : ELSE
990 : CALL dbcsr_iterator_next_block_prv(iterator%dbcsr, row=my_row, column=my_column, &
991 : block=my_block, row_size=row_size, col_size=col_size, &
992 211205370 : row_offset=row_offset, col_offset=col_offset)
993 : END IF
994 211206794 : IF (PRESENT(block)) block => my_block
995 211206794 : IF (PRESENT(row)) row = my_row
996 211206794 : IF (PRESENT(column)) column = my_column
997 : ELSE
998 : CPABORT("Not yet implemented for DBM.")
999 : END IF
1000 211206794 : END SUBROUTINE dbcsr_iterator_next_block
1001 :
1002 : ! **************************************************************************************************
1003 : !> \brief ...
1004 : !> \param iterator ...
1005 : !> \param matrix ...
1006 : !> \param shared ...
1007 : !> \param dynamic ...
1008 : !> \param dynamic_byrows ...
1009 : ! **************************************************************************************************
1010 17361851 : SUBROUTINE dbcsr_iterator_start(iterator, matrix, shared, dynamic, dynamic_byrows)
1011 : TYPE(dbcsr_iterator_type), INTENT(OUT) :: iterator
1012 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1013 : LOGICAL, INTENT(IN), OPTIONAL :: shared, dynamic, dynamic_byrows
1014 :
1015 17361851 : IF (USE_DBCSR_BACKEND) THEN
1016 : CALL dbcsr_iterator_start_prv(iterator%dbcsr, matrix%dbcsr, shared, dynamic, dynamic_byrows)
1017 : ELSE
1018 : CPABORT("Not yet implemented for DBM.")
1019 : END IF
1020 17361851 : END SUBROUTINE dbcsr_iterator_start
1021 :
1022 : ! **************************************************************************************************
1023 : !> \brief Like dbcsr_iterator_start() but with matrix being INTENT(IN).
1024 : !> When invoking this routine, the caller promises not to modify the returned blocks.
1025 : !> \param iterator ...
1026 : !> \param matrix ...
1027 : !> \param shared ...
1028 : !> \param dynamic ...
1029 : !> \param dynamic_byrows ...
1030 : ! **************************************************************************************************
1031 5712544 : SUBROUTINE dbcsr_iterator_readonly_start(iterator, matrix, shared, dynamic, dynamic_byrows)
1032 : TYPE(dbcsr_iterator_type), INTENT(OUT) :: iterator
1033 : TYPE(dbcsr_type), INTENT(IN) :: matrix
1034 : LOGICAL, INTENT(IN), OPTIONAL :: shared, dynamic, dynamic_byrows
1035 :
1036 : IF (USE_DBCSR_BACKEND) THEN
1037 : CALL dbcsr_iterator_start_prv(iterator%dbcsr, matrix%dbcsr, shared, dynamic, &
1038 5712544 : dynamic_byrows, read_only=.TRUE.)
1039 : ELSE
1040 : CPABORT("Not yet implemented for DBM.")
1041 : END IF
1042 5712544 : END SUBROUTINE dbcsr_iterator_readonly_start
1043 :
1044 : ! **************************************************************************************************
1045 : !> \brief ...
1046 : !> \param iterator ...
1047 : ! **************************************************************************************************
1048 23074395 : SUBROUTINE dbcsr_iterator_stop(iterator)
1049 : TYPE(dbcsr_iterator_type), INTENT(INOUT) :: iterator
1050 :
1051 23074395 : IF (USE_DBCSR_BACKEND) THEN
1052 : CALL dbcsr_iterator_stop_prv(iterator%dbcsr)
1053 : ELSE
1054 : CPABORT("Not yet implemented for DBM.")
1055 : END IF
1056 23074395 : END SUBROUTINE dbcsr_iterator_stop
1057 :
1058 : ! **************************************************************************************************
1059 : !> \brief ...
1060 : !> \param dist ...
1061 : ! **************************************************************************************************
1062 143149 : SUBROUTINE dbcsr_mp_grid_setup(dist)
1063 : TYPE(dbcsr_distribution_type), INTENT(INOUT) :: dist
1064 :
1065 143149 : IF (USE_DBCSR_BACKEND) THEN
1066 : CALL dbcsr_mp_grid_setup_prv(dist%dbcsr)
1067 : ELSE
1068 : CPABORT("Not yet implemented for DBM.")
1069 : END IF
1070 143149 : END SUBROUTINE dbcsr_mp_grid_setup
1071 :
1072 : ! **************************************************************************************************
1073 : !> \brief ...
1074 : !> \param transa ...
1075 : !> \param transb ...
1076 : !> \param alpha ...
1077 : !> \param matrix_a ...
1078 : !> \param matrix_b ...
1079 : !> \param beta ...
1080 : !> \param matrix_c ...
1081 : !> \param first_row ...
1082 : !> \param last_row ...
1083 : !> \param first_column ...
1084 : !> \param last_column ...
1085 : !> \param first_k ...
1086 : !> \param last_k ...
1087 : !> \param retain_sparsity ...
1088 : !> \param filter_eps ...
1089 : !> \param flop ...
1090 : ! **************************************************************************************************
1091 3544378 : SUBROUTINE dbcsr_multiply(transa, transb, alpha, matrix_a, matrix_b, beta, &
1092 : matrix_c, first_row, last_row, &
1093 : first_column, last_column, first_k, last_k, &
1094 : retain_sparsity, filter_eps, flop)
1095 : CHARACTER(LEN=1), INTENT(IN) :: transa, transb
1096 : REAL(kind=dp), INTENT(IN) :: alpha
1097 : TYPE(dbcsr_type), INTENT(IN) :: matrix_a, matrix_b
1098 : REAL(kind=dp), INTENT(IN) :: beta
1099 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix_c
1100 : INTEGER, INTENT(IN), OPTIONAL :: first_row, last_row, first_column, &
1101 : last_column, first_k, last_k
1102 : LOGICAL, INTENT(IN), OPTIONAL :: retain_sparsity
1103 : REAL(kind=dp), INTENT(IN), OPTIONAL :: filter_eps
1104 : INTEGER(int_8), INTENT(OUT), OPTIONAL :: flop
1105 :
1106 : IF (USE_DBCSR_BACKEND) THEN
1107 : CALL dbcsr_multiply_prv(transa, transb, alpha, matrix_a%dbcsr, matrix_b%dbcsr, beta, &
1108 : matrix_c%dbcsr, first_row, last_row, first_column, last_column, &
1109 3544378 : first_k, last_k, retain_sparsity, filter_eps=filter_eps, flop=flop)
1110 : ELSE
1111 : CPABORT("Not yet implemented for DBM.")
1112 : END IF
1113 3544378 : END SUBROUTINE dbcsr_multiply
1114 :
1115 : ! **************************************************************************************************
1116 : !> \brief ...
1117 : !> \param matrix ...
1118 : !> \param row ...
1119 : !> \param col ...
1120 : !> \param block ...
1121 : !> \param summation ...
1122 : ! **************************************************************************************************
1123 888856 : SUBROUTINE dbcsr_put_block(matrix, row, col, block, summation)
1124 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1125 : INTEGER, INTENT(IN) :: row, col
1126 : REAL(kind=dp), DIMENSION(:, :), INTENT(IN) :: block
1127 : LOGICAL, INTENT(IN), OPTIONAL :: summation
1128 :
1129 : IF (USE_DBCSR_BACKEND) THEN
1130 888856 : CALL dbcsr_put_block_prv(matrix%dbcsr, row, col, block, summation=summation)
1131 : ELSE
1132 : CPABORT("Not yet implemented for DBM.")
1133 : END IF
1134 888856 : END SUBROUTINE dbcsr_put_block
1135 :
1136 : ! **************************************************************************************************
1137 : !> \brief ...
1138 : !> \param matrix ...
1139 : ! **************************************************************************************************
1140 11122665 : SUBROUTINE dbcsr_release(matrix)
1141 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1142 :
1143 11122665 : IF (USE_DBCSR_BACKEND) THEN
1144 : CALL dbcsr_release_prv(matrix%dbcsr)
1145 : ELSE
1146 : CPABORT("Not yet implemented for DBM.")
1147 : END IF
1148 11122665 : END SUBROUTINE dbcsr_release
1149 :
1150 : ! **************************************************************************************************
1151 : !> \brief ...
1152 : !> \param matrix ...
1153 : ! **************************************************************************************************
1154 159102 : SUBROUTINE dbcsr_replicate_all(matrix)
1155 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1156 :
1157 159102 : IF (USE_DBCSR_BACKEND) THEN
1158 : CALL dbcsr_replicate_all_prv(matrix%dbcsr)
1159 : ELSE
1160 : CPABORT("Not yet implemented for DBM.")
1161 : END IF
1162 159102 : END SUBROUTINE dbcsr_replicate_all
1163 :
1164 : ! **************************************************************************************************
1165 : !> \brief ...
1166 : !> \param matrix ...
1167 : !> \param rows ...
1168 : !> \param cols ...
1169 : ! **************************************************************************************************
1170 4724890 : SUBROUTINE dbcsr_reserve_blocks(matrix, rows, cols)
1171 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1172 : INTEGER, DIMENSION(:), INTENT(IN) :: rows, cols
1173 :
1174 : IF (USE_DBCSR_BACKEND) THEN
1175 4724890 : CALL dbcsr_reserve_blocks_prv(matrix%dbcsr, rows, cols)
1176 : ELSE
1177 : CPABORT("Not yet implemented for DBM.")
1178 : END IF
1179 4724890 : END SUBROUTINE dbcsr_reserve_blocks
1180 :
1181 : ! **************************************************************************************************
1182 : !> \brief ...
1183 : !> \param matrix ...
1184 : !> \param alpha_scalar ...
1185 : ! **************************************************************************************************
1186 450321 : SUBROUTINE dbcsr_scale(matrix, alpha_scalar)
1187 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1188 : REAL(kind=dp), INTENT(IN) :: alpha_scalar
1189 :
1190 450321 : IF (USE_DBCSR_BACKEND) THEN
1191 : CALL dbcsr_scale_prv(matrix%dbcsr, alpha_scalar)
1192 : ELSE
1193 : CALL dbm_scale(matrix%dbm, alpha_scalar)
1194 : END IF
1195 450321 : END SUBROUTINE dbcsr_scale
1196 :
1197 : ! **************************************************************************************************
1198 : !> \brief ...
1199 : !> \param matrix ...
1200 : !> \param alpha ...
1201 : ! **************************************************************************************************
1202 7141722 : SUBROUTINE dbcsr_set(matrix, alpha)
1203 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1204 : REAL(kind=dp), INTENT(IN) :: alpha
1205 :
1206 : IF (USE_DBCSR_BACKEND) THEN
1207 7141722 : CALL dbcsr_set_prv(matrix%dbcsr, alpha)
1208 : ELSE
1209 : IF (alpha == 0.0_dp) THEN
1210 : CALL dbm_zero(matrix%dbm)
1211 : ELSE
1212 : CPABORT("Not yet implemented for DBM.")
1213 : END IF
1214 : END IF
1215 7141722 : END SUBROUTINE dbcsr_set
1216 :
1217 : ! **************************************************************************************************
1218 : !> \brief ...
1219 : !> \param matrix ...
1220 : ! **************************************************************************************************
1221 53090 : SUBROUTINE dbcsr_sum_replicated(matrix)
1222 : TYPE(dbcsr_type), INTENT(inout) :: matrix
1223 :
1224 53090 : IF (USE_DBCSR_BACKEND) THEN
1225 : CALL dbcsr_sum_replicated_prv(matrix%dbcsr)
1226 : ELSE
1227 : CPABORT("Not yet implemented for DBM.")
1228 : END IF
1229 53090 : END SUBROUTINE dbcsr_sum_replicated
1230 :
1231 : ! **************************************************************************************************
1232 : !> \brief ...
1233 : !> \param transposed ...
1234 : !> \param normal ...
1235 : !> \param shallow_data_copy ...
1236 : !> \param transpose_distribution ...
1237 : !> \param use_distribution ...
1238 : ! **************************************************************************************************
1239 182564 : SUBROUTINE dbcsr_transposed(transposed, normal, shallow_data_copy, transpose_distribution, &
1240 : use_distribution)
1241 : TYPE(dbcsr_type), INTENT(INOUT) :: transposed
1242 : TYPE(dbcsr_type), INTENT(IN) :: normal
1243 : LOGICAL, INTENT(IN), OPTIONAL :: shallow_data_copy, transpose_distribution
1244 : TYPE(dbcsr_distribution_type), INTENT(IN), &
1245 : OPTIONAL :: use_distribution
1246 :
1247 : IF (USE_DBCSR_BACKEND) THEN
1248 182564 : IF (PRESENT(use_distribution)) THEN
1249 : CALL dbcsr_transposed_prv(transposed%dbcsr, normal%dbcsr, &
1250 : shallow_data_copy=shallow_data_copy, &
1251 : transpose_distribution=transpose_distribution, &
1252 98042 : use_distribution=use_distribution%dbcsr)
1253 : ELSE
1254 : CALL dbcsr_transposed_prv(transposed%dbcsr, normal%dbcsr, &
1255 : shallow_data_copy=shallow_data_copy, &
1256 84522 : transpose_distribution=transpose_distribution)
1257 : END IF
1258 : ELSE
1259 : CPABORT("Not yet implemented for DBM.")
1260 : END IF
1261 182564 : END SUBROUTINE dbcsr_transposed
1262 :
1263 : ! **************************************************************************************************
1264 : !> \brief ...
1265 : !> \param matrix ...
1266 : !> \return ...
1267 : ! **************************************************************************************************
1268 2963187 : FUNCTION dbcsr_valid_index(matrix) RESULT(valid_index)
1269 : TYPE(dbcsr_type), INTENT(IN) :: matrix
1270 : LOGICAL :: valid_index
1271 :
1272 2963187 : IF (USE_DBCSR_BACKEND) THEN
1273 : valid_index = dbcsr_valid_index_prv(matrix%dbcsr)
1274 : ELSE
1275 : valid_index = .TRUE. ! Does not apply to DBM.
1276 : END IF
1277 2963187 : END FUNCTION dbcsr_valid_index
1278 :
1279 : ! **************************************************************************************************
1280 : !> \brief ...
1281 : !> \param matrix ...
1282 : !> \param verbosity ...
1283 : !> \param local ...
1284 : ! **************************************************************************************************
1285 240042 : SUBROUTINE dbcsr_verify_matrix(matrix, verbosity, local)
1286 : TYPE(dbcsr_type), INTENT(IN) :: matrix
1287 : INTEGER, INTENT(IN), OPTIONAL :: verbosity
1288 : LOGICAL, INTENT(IN), OPTIONAL :: local
1289 :
1290 240042 : IF (USE_DBCSR_BACKEND) THEN
1291 : CALL dbcsr_verify_matrix_prv(matrix%dbcsr, verbosity, local)
1292 : ELSE
1293 : ! Does not apply to DBM.
1294 : END IF
1295 240042 : END SUBROUTINE dbcsr_verify_matrix
1296 :
1297 : ! **************************************************************************************************
1298 : !> \brief ...
1299 : !> \param matrix ...
1300 : !> \param nblks_guess ...
1301 : !> \param sizedata_guess ...
1302 : !> \param n ...
1303 : !> \param work_mutable ...
1304 : ! **************************************************************************************************
1305 7012 : SUBROUTINE dbcsr_work_create(matrix, nblks_guess, sizedata_guess, n, work_mutable)
1306 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1307 : INTEGER, INTENT(IN), OPTIONAL :: nblks_guess, sizedata_guess, n
1308 : LOGICAL, INTENT(in), OPTIONAL :: work_mutable
1309 :
1310 7012 : IF (USE_DBCSR_BACKEND) THEN
1311 : CALL dbcsr_work_create_prv(matrix%dbcsr, nblks_guess, sizedata_guess, n, work_mutable)
1312 : ELSE
1313 : ! Does not apply to DBM.
1314 : END IF
1315 7012 : END SUBROUTINE dbcsr_work_create
1316 :
1317 : ! **************************************************************************************************
1318 : !> \brief ...
1319 : !> \param matrix_a ...
1320 : !> \param matrix_b ...
1321 : !> \param RESULT ...
1322 : ! **************************************************************************************************
1323 46917 : SUBROUTINE dbcsr_dot_threadsafe(matrix_a, matrix_b, RESULT)
1324 : TYPE(dbcsr_type), INTENT(IN) :: matrix_a, matrix_b
1325 : REAL(kind=dp), INTENT(INOUT) :: result
1326 :
1327 46917 : IF (USE_DBCSR_BACKEND) THEN
1328 : CALL dbcsr_dot_prv(matrix_a%dbcsr, matrix_b%dbcsr, RESULT)
1329 : ELSE
1330 : CPABORT("Not yet implemented for DBM.")
1331 : END IF
1332 46917 : END SUBROUTINE dbcsr_dot_threadsafe
1333 :
1334 0 : END MODULE cp_dbcsr_api
|
