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