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 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 319793 : SUBROUTINE dbcsr_init_p(matrix)
207 : TYPE(dbcsr_type), POINTER :: matrix
208 :
209 319793 : IF (ASSOCIATED(matrix)) THEN
210 22322 : CALL dbcsr_release(matrix)
211 22322 : DEALLOCATE (matrix)
212 : END IF
213 :
214 319793 : ALLOCATE (matrix)
215 319793 : END SUBROUTINE dbcsr_init_p
216 :
217 : ! **************************************************************************************************
218 : !> \brief ...
219 : !> \param matrix ...
220 : ! **************************************************************************************************
221 223368 : SUBROUTINE dbcsr_release_p(matrix)
222 : TYPE(dbcsr_type), POINTER :: matrix
223 :
224 223368 : IF (ASSOCIATED(matrix)) THEN
225 222628 : CALL dbcsr_release(matrix)
226 222628 : DEALLOCATE (matrix)
227 : END IF
228 223368 : END SUBROUTINE dbcsr_release_p
229 :
230 : ! **************************************************************************************************
231 : !> \brief ...
232 : !> \param matrix ...
233 : ! **************************************************************************************************
234 1327545 : SUBROUTINE dbcsr_deallocate_matrix(matrix)
235 : TYPE(dbcsr_type), POINTER :: matrix
236 :
237 1327545 : CALL dbcsr_release(matrix)
238 1327545 : 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 1327545 : DEALLOCATE (matrix)
243 1327545 : 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 2064866 : 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 2064866 : 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 2064866 : END SUBROUTINE dbcsr_add
264 :
265 : ! **************************************************************************************************
266 : !> \brief ...
267 : !> \param filepath ...
268 : !> \param distribution ...
269 : !> \param matrix_new ...
270 : ! **************************************************************************************************
271 36 : 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 36 : 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 36 : 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 113590 : SUBROUTINE dbcsr_clear(matrix)
304 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
305 :
306 113590 : IF (USE_DBCSR_BACKEND) THEN
307 : CALL dbcsr_clear_prv(matrix%dbcsr)
308 : ELSE
309 : CALL dbm_clear(matrix%dbm)
310 : END IF
311 113590 : END SUBROUTINE dbcsr_clear
312 :
313 : ! **************************************************************************************************
314 : !> \brief ...
315 : !> \param matrix ...
316 : !> \param redist ...
317 : ! **************************************************************************************************
318 2165089 : SUBROUTINE dbcsr_complete_redistribute(matrix, redist)
319 : TYPE(dbcsr_type), INTENT(IN) :: matrix
320 : TYPE(dbcsr_type), INTENT(INOUT) :: redist
321 :
322 2165089 : 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 2165089 : 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 142 : 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 142 : 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 142 : 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 3967557 : 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 6940865 : 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 3967557 : 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 4470505 : 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 4470505 : reuse_arrays=reuse_arrays, mutable_work=mutable_work)
411 : ELSE
412 : CPABORT("Not yet implemented for DBM.")
413 : END IF
414 4470505 : 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 2458650 : 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 2458650 : 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 33610 : 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 4725980 : mutable_work=mutable_work)
453 : END IF
454 : ELSE
455 : CPABORT("Not yet implemented for DBM.")
456 : END IF
457 2458650 : 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 142 : 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 142 : 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 142 : dist_format, numnodes=numnodes)
482 : END IF
483 : ELSE
484 : CPABORT("Not yet implemented for DBM.")
485 : END IF
486 142 : 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 1235333 : 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 1235333 : 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 1235333 : END SUBROUTINE dbcsr_desymmetrize
533 :
534 : ! **************************************************************************************************
535 : !> \brief ...
536 : !> \param matrix ...
537 : ! **************************************************************************************************
538 52914 : SUBROUTINE dbcsr_distribute(matrix)
539 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
540 :
541 52914 : 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 52914 : 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 7119070 : 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 7119070 : pgrid, subgroups_defined, prow_group, pcol_group)
585 : ELSE
586 : CPABORT("Not yet implemented for DBM.")
587 : END IF
588 7119070 : END SUBROUTINE dbcsr_distribution_get
589 :
590 : ! **************************************************************************************************
591 : !> \brief ...
592 : !> \param dist ...
593 : ! **************************************************************************************************
594 912 : SUBROUTINE dbcsr_distribution_hold(dist)
595 : TYPE(dbcsr_distribution_type) :: dist
596 :
597 912 : 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 912 : 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 4101445 : 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 4101445 : IF (PRESENT(template)) THEN
625 : CALL dbcsr_distribution_new_prv(dist%dbcsr, template%dbcsr, group, pgrid, &
626 1951548 : 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 2149897 : reuse_arrays=reuse_arrays)
631 : END IF
632 : ELSE
633 : CPABORT("Not yet implemented for DBM.")
634 : END IF
635 4101445 : END SUBROUTINE dbcsr_distribution_new
636 :
637 : ! **************************************************************************************************
638 : !> \brief ...
639 : !> \param dist ...
640 : ! **************************************************************************************************
641 4102357 : SUBROUTINE dbcsr_distribution_release(dist)
642 : TYPE(dbcsr_distribution_type) :: dist
643 :
644 4102357 : 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 4102357 : END SUBROUTINE dbcsr_distribution_release
650 :
651 : ! **************************************************************************************************
652 : !> \brief ...
653 : !> \param matrix ...
654 : !> \param eps ...
655 : ! **************************************************************************************************
656 580343 : SUBROUTINE dbcsr_filter(matrix, eps)
657 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
658 : REAL(dp), INTENT(IN) :: eps
659 :
660 580343 : 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 580343 : END SUBROUTINE dbcsr_filter
666 :
667 : ! **************************************************************************************************
668 : !> \brief ...
669 : !> \param matrix ...
670 : ! **************************************************************************************************
671 2376231 : SUBROUTINE dbcsr_finalize(matrix)
672 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
673 :
674 2376231 : 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 2376231 : 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 209508126 : 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 209508126 : 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 209508126 : 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 33869065 : 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 33869065 : matrix_p => matrix ! Hacky workaround to shake the INTENT(IN).
734 33869065 : 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 33869065 : END SUBROUTINE dbcsr_get_readonly_block_p
739 :
740 : ! **************************************************************************************************
741 : !> \brief ...
742 : !> \param matrix ...
743 : !> \param lb ...
744 : !> \param ub ...
745 : !> \return ...
746 : ! **************************************************************************************************
747 5393471 : 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 5393471 : 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 5393471 : 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 25641142 : 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 74031246 : group=group_handle)
846 :
847 25641142 : IF (PRESENT(distribution)) distribution%dbcsr = my_distribution
848 25641142 : IF (PRESENT(group)) CALL group%set_handle(group_handle)
849 : ELSE
850 : CPABORT("Not yet implemented for DBM.")
851 : END IF
852 25641142 : END SUBROUTINE dbcsr_get_info
853 :
854 : ! **************************************************************************************************
855 : !> \brief ...
856 : !> \param matrix ...
857 : !> \return ...
858 : ! **************************************************************************************************
859 1232591 : 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 1232591 : matrix_type = dbcsr_get_matrix_type_prv(matrix%dbcsr)
865 : ELSE
866 : CPABORT("Not yet implemented for DBM.")
867 : END IF
868 1232591 : END FUNCTION dbcsr_get_matrix_type
869 :
870 : ! **************************************************************************************************
871 : !> \brief ...
872 : !> \param matrix ...
873 : !> \return ...
874 : ! **************************************************************************************************
875 81684 : FUNCTION dbcsr_get_num_blocks(matrix) RESULT(num_blocks)
876 : TYPE(dbcsr_type), INTENT(IN) :: matrix
877 : INTEGER :: num_blocks
878 :
879 81684 : 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 81684 : END FUNCTION dbcsr_get_num_blocks
885 :
886 : ! **************************************************************************************************
887 : !> \brief ...
888 : !> \param matrix ...
889 : !> \return ...
890 : ! **************************************************************************************************
891 226838 : FUNCTION dbcsr_get_occupation(matrix) RESULT(occupation)
892 : TYPE(dbcsr_type), INTENT(IN) :: matrix
893 : REAL(KIND=dp) :: occupation
894 :
895 226838 : 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 226838 : END FUNCTION dbcsr_get_occupation
901 :
902 : ! **************************************************************************************************
903 : !> \brief ...
904 : !> \param matrix ...
905 : !> \param row ...
906 : !> \param column ...
907 : !> \param processor ...
908 : ! **************************************************************************************************
909 1321080 : 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 1321080 : CALL dbcsr_get_stored_coordinates_prv(matrix%dbcsr, row, column, processor)
916 : ELSE
917 : CPABORT("Not yet implemented for DBM.")
918 : END IF
919 1321080 : END SUBROUTINE dbcsr_get_stored_coordinates
920 :
921 : ! **************************************************************************************************
922 : !> \brief ...
923 : !> \param matrix ...
924 : !> \return ...
925 : ! **************************************************************************************************
926 6882025 : FUNCTION dbcsr_has_symmetry(matrix) RESULT(has_symmetry)
927 : TYPE(dbcsr_type), INTENT(IN) :: matrix
928 : LOGICAL :: has_symmetry
929 :
930 6882025 : 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 6882025 : END FUNCTION dbcsr_has_symmetry
936 :
937 : ! **************************************************************************************************
938 : !> \brief ...
939 : !> \param iterator ...
940 : !> \return ...
941 : ! **************************************************************************************************
942 146629514 : FUNCTION dbcsr_iterator_blocks_left(iterator) RESULT(blocks_left)
943 : TYPE(dbcsr_iterator_type), INTENT(IN) :: iterator
944 : LOGICAL :: blocks_left
945 :
946 146629514 : 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 146629514 : 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 : ! **************************************************************************************************
965 266557464 : SUBROUTINE dbcsr_iterator_next_block(iterator, row, column, block, &
966 : block_number_argument_has_been_removed, &
967 : row_size, col_size, &
968 : row_offset, col_offset)
969 : TYPE(dbcsr_iterator_type), INTENT(INOUT) :: iterator
970 : INTEGER, INTENT(OUT), OPTIONAL :: row, column
971 : REAL(kind=dp), DIMENSION(:, :), OPTIONAL, POINTER :: block
972 : LOGICAL, OPTIONAL :: block_number_argument_has_been_removed
973 : INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size, row_offset, &
974 : col_offset
975 :
976 : INTEGER :: my_column, my_row
977 133278732 : REAL(kind=dp), DIMENSION(:, :), POINTER :: my_block
978 :
979 0 : CPASSERT(.NOT. PRESENT(block_number_argument_has_been_removed))
980 :
981 : IF (USE_DBCSR_BACKEND) THEN
982 : CALL dbcsr_iterator_next_block_prv(iterator%dbcsr, row=my_row, column=my_column, &
983 : block=my_block, row_size=row_size, col_size=col_size, &
984 133278732 : row_offset=row_offset, col_offset=col_offset)
985 133278732 : IF (PRESENT(block)) block => my_block
986 133278732 : IF (PRESENT(row)) row = my_row
987 133278732 : IF (PRESENT(column)) column = my_column
988 : ELSE
989 : CPABORT("Not yet implemented for DBM.")
990 : END IF
991 133278732 : END SUBROUTINE dbcsr_iterator_next_block
992 :
993 : ! **************************************************************************************************
994 : !> \brief ...
995 : !> \param iterator ...
996 : !> \param matrix ...
997 : !> \param shared ...
998 : !> \param dynamic ...
999 : !> \param dynamic_byrows ...
1000 : ! **************************************************************************************************
1001 10094910 : SUBROUTINE dbcsr_iterator_start(iterator, matrix, shared, dynamic, dynamic_byrows)
1002 : TYPE(dbcsr_iterator_type), INTENT(OUT) :: iterator
1003 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1004 : LOGICAL, INTENT(IN), OPTIONAL :: shared, dynamic, dynamic_byrows
1005 :
1006 10094910 : IF (USE_DBCSR_BACKEND) THEN
1007 : CALL dbcsr_iterator_start_prv(iterator%dbcsr, matrix%dbcsr, shared, dynamic, dynamic_byrows)
1008 : ELSE
1009 : CPABORT("Not yet implemented for DBM.")
1010 : END IF
1011 10094910 : END SUBROUTINE dbcsr_iterator_start
1012 :
1013 : ! **************************************************************************************************
1014 : !> \brief Like dbcsr_iterator_start() but with matrix being INTENT(IN).
1015 : !> When invoking this routine, the caller promises not to modify the returned blocks.
1016 : !> \param iterator ...
1017 : !> \param matrix ...
1018 : !> \param shared ...
1019 : !> \param dynamic ...
1020 : !> \param dynamic_byrows ...
1021 : ! **************************************************************************************************
1022 3595547 : SUBROUTINE dbcsr_iterator_readonly_start(iterator, matrix, shared, dynamic, dynamic_byrows)
1023 : TYPE(dbcsr_iterator_type), INTENT(OUT) :: iterator
1024 : TYPE(dbcsr_type), INTENT(IN) :: matrix
1025 : LOGICAL, INTENT(IN), OPTIONAL :: shared, dynamic, dynamic_byrows
1026 :
1027 : IF (USE_DBCSR_BACKEND) THEN
1028 : CALL dbcsr_iterator_start_prv(iterator%dbcsr, matrix%dbcsr, shared, dynamic, &
1029 3595547 : dynamic_byrows, read_only=.TRUE.)
1030 : ELSE
1031 : CPABORT("Not yet implemented for DBM.")
1032 : END IF
1033 3595547 : END SUBROUTINE dbcsr_iterator_readonly_start
1034 :
1035 : ! **************************************************************************************************
1036 : !> \brief ...
1037 : !> \param iterator ...
1038 : ! **************************************************************************************************
1039 13690457 : SUBROUTINE dbcsr_iterator_stop(iterator)
1040 : TYPE(dbcsr_iterator_type), INTENT(INOUT) :: iterator
1041 :
1042 13690457 : IF (USE_DBCSR_BACKEND) THEN
1043 : CALL dbcsr_iterator_stop_prv(iterator%dbcsr)
1044 : ELSE
1045 : CPABORT("Not yet implemented for DBM.")
1046 : END IF
1047 13690457 : END SUBROUTINE dbcsr_iterator_stop
1048 :
1049 : ! **************************************************************************************************
1050 : !> \brief ...
1051 : !> \param dist ...
1052 : ! **************************************************************************************************
1053 137255 : SUBROUTINE dbcsr_mp_grid_setup(dist)
1054 : TYPE(dbcsr_distribution_type), INTENT(INOUT) :: dist
1055 :
1056 137255 : IF (USE_DBCSR_BACKEND) THEN
1057 : CALL dbcsr_mp_grid_setup_prv(dist%dbcsr)
1058 : ELSE
1059 : CPABORT("Not yet implemented for DBM.")
1060 : END IF
1061 137255 : END SUBROUTINE dbcsr_mp_grid_setup
1062 :
1063 : ! **************************************************************************************************
1064 : !> \brief ...
1065 : !> \param transa ...
1066 : !> \param transb ...
1067 : !> \param alpha ...
1068 : !> \param matrix_a ...
1069 : !> \param matrix_b ...
1070 : !> \param beta ...
1071 : !> \param matrix_c ...
1072 : !> \param first_row ...
1073 : !> \param last_row ...
1074 : !> \param first_column ...
1075 : !> \param last_column ...
1076 : !> \param first_k ...
1077 : !> \param last_k ...
1078 : !> \param retain_sparsity ...
1079 : !> \param filter_eps ...
1080 : !> \param flop ...
1081 : ! **************************************************************************************************
1082 3347308 : SUBROUTINE dbcsr_multiply(transa, transb, alpha, matrix_a, matrix_b, beta, &
1083 : matrix_c, first_row, last_row, &
1084 : first_column, last_column, first_k, last_k, &
1085 : retain_sparsity, filter_eps, flop)
1086 : CHARACTER(LEN=1), INTENT(IN) :: transa, transb
1087 : REAL(kind=dp), INTENT(IN) :: alpha
1088 : TYPE(dbcsr_type), INTENT(IN) :: matrix_a, matrix_b
1089 : REAL(kind=dp), INTENT(IN) :: beta
1090 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix_c
1091 : INTEGER, INTENT(IN), OPTIONAL :: first_row, last_row, first_column, &
1092 : last_column, first_k, last_k
1093 : LOGICAL, INTENT(IN), OPTIONAL :: retain_sparsity
1094 : REAL(kind=dp), INTENT(IN), OPTIONAL :: filter_eps
1095 : INTEGER(int_8), INTENT(OUT), OPTIONAL :: flop
1096 :
1097 : IF (USE_DBCSR_BACKEND) THEN
1098 : CALL dbcsr_multiply_prv(transa, transb, alpha, matrix_a%dbcsr, matrix_b%dbcsr, beta, &
1099 : matrix_c%dbcsr, first_row, last_row, first_column, last_column, &
1100 3347308 : first_k, last_k, retain_sparsity, filter_eps=filter_eps, flop=flop)
1101 : ELSE
1102 : CPABORT("Not yet implemented for DBM.")
1103 : END IF
1104 3347308 : END SUBROUTINE dbcsr_multiply
1105 :
1106 : ! **************************************************************************************************
1107 : !> \brief ...
1108 : !> \param matrix ...
1109 : !> \param row ...
1110 : !> \param col ...
1111 : !> \param block ...
1112 : !> \param summation ...
1113 : ! **************************************************************************************************
1114 854393 : SUBROUTINE dbcsr_put_block(matrix, row, col, block, summation)
1115 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1116 : INTEGER, INTENT(IN) :: row, col
1117 : REAL(kind=dp), DIMENSION(:, :), INTENT(IN) :: block
1118 : LOGICAL, INTENT(IN), OPTIONAL :: summation
1119 :
1120 : IF (USE_DBCSR_BACKEND) THEN
1121 854393 : CALL dbcsr_put_block_prv(matrix%dbcsr, row, col, block, summation=summation)
1122 : ELSE
1123 : CPABORT("Not yet implemented for DBM.")
1124 : END IF
1125 854393 : END SUBROUTINE dbcsr_put_block
1126 :
1127 : ! **************************************************************************************************
1128 : !> \brief ...
1129 : !> \param matrix ...
1130 : ! **************************************************************************************************
1131 8111887 : SUBROUTINE dbcsr_release(matrix)
1132 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1133 :
1134 8111887 : IF (USE_DBCSR_BACKEND) THEN
1135 : CALL dbcsr_release_prv(matrix%dbcsr)
1136 : ELSE
1137 : CPABORT("Not yet implemented for DBM.")
1138 : END IF
1139 8111887 : END SUBROUTINE dbcsr_release
1140 :
1141 : ! **************************************************************************************************
1142 : !> \brief ...
1143 : !> \param matrix ...
1144 : ! **************************************************************************************************
1145 101706 : SUBROUTINE dbcsr_replicate_all(matrix)
1146 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1147 :
1148 101706 : IF (USE_DBCSR_BACKEND) THEN
1149 : CALL dbcsr_replicate_all_prv(matrix%dbcsr)
1150 : ELSE
1151 : CPABORT("Not yet implemented for DBM.")
1152 : END IF
1153 101706 : END SUBROUTINE dbcsr_replicate_all
1154 :
1155 : ! **************************************************************************************************
1156 : !> \brief ...
1157 : !> \param matrix ...
1158 : !> \param rows ...
1159 : !> \param cols ...
1160 : ! **************************************************************************************************
1161 3110094 : SUBROUTINE dbcsr_reserve_blocks(matrix, rows, cols)
1162 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1163 : INTEGER, DIMENSION(:), INTENT(IN) :: rows, cols
1164 :
1165 : IF (USE_DBCSR_BACKEND) THEN
1166 3110094 : CALL dbcsr_reserve_blocks_prv(matrix%dbcsr, rows, cols)
1167 : ELSE
1168 : CPABORT("Not yet implemented for DBM.")
1169 : END IF
1170 3110094 : END SUBROUTINE dbcsr_reserve_blocks
1171 :
1172 : ! **************************************************************************************************
1173 : !> \brief ...
1174 : !> \param matrix ...
1175 : !> \param alpha_scalar ...
1176 : ! **************************************************************************************************
1177 426155 : SUBROUTINE dbcsr_scale(matrix, alpha_scalar)
1178 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1179 : REAL(kind=dp), INTENT(IN) :: alpha_scalar
1180 :
1181 426155 : IF (USE_DBCSR_BACKEND) THEN
1182 : CALL dbcsr_scale_prv(matrix%dbcsr, alpha_scalar)
1183 : ELSE
1184 : CALL dbm_scale(matrix%dbm, alpha_scalar)
1185 : END IF
1186 426155 : END SUBROUTINE dbcsr_scale
1187 :
1188 : ! **************************************************************************************************
1189 : !> \brief ...
1190 : !> \param matrix ...
1191 : !> \param alpha ...
1192 : ! **************************************************************************************************
1193 4850306 : SUBROUTINE dbcsr_set(matrix, alpha)
1194 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1195 : REAL(kind=dp), INTENT(IN) :: alpha
1196 :
1197 : IF (USE_DBCSR_BACKEND) THEN
1198 4850306 : CALL dbcsr_set_prv(matrix%dbcsr, alpha)
1199 : ELSE
1200 : IF (alpha == 0.0_dp) THEN
1201 : CALL dbm_zero(matrix%dbm)
1202 : ELSE
1203 : CPABORT("Not yet implemented for DBM.")
1204 : END IF
1205 : END IF
1206 4850306 : END SUBROUTINE dbcsr_set
1207 :
1208 : ! **************************************************************************************************
1209 : !> \brief ...
1210 : !> \param matrix ...
1211 : ! **************************************************************************************************
1212 52914 : SUBROUTINE dbcsr_sum_replicated(matrix)
1213 : TYPE(dbcsr_type), INTENT(inout) :: matrix
1214 :
1215 52914 : IF (USE_DBCSR_BACKEND) THEN
1216 : CALL dbcsr_sum_replicated_prv(matrix%dbcsr)
1217 : ELSE
1218 : CPABORT("Not yet implemented for DBM.")
1219 : END IF
1220 52914 : END SUBROUTINE dbcsr_sum_replicated
1221 :
1222 : ! **************************************************************************************************
1223 : !> \brief ...
1224 : !> \param transposed ...
1225 : !> \param normal ...
1226 : !> \param shallow_data_copy ...
1227 : !> \param transpose_distribution ...
1228 : !> \param use_distribution ...
1229 : ! **************************************************************************************************
1230 176778 : SUBROUTINE dbcsr_transposed(transposed, normal, shallow_data_copy, transpose_distribution, &
1231 : use_distribution)
1232 : TYPE(dbcsr_type), INTENT(INOUT) :: transposed
1233 : TYPE(dbcsr_type), INTENT(IN) :: normal
1234 : LOGICAL, INTENT(IN), OPTIONAL :: shallow_data_copy, transpose_distribution
1235 : TYPE(dbcsr_distribution_type), INTENT(IN), &
1236 : OPTIONAL :: use_distribution
1237 :
1238 : IF (USE_DBCSR_BACKEND) THEN
1239 176778 : IF (PRESENT(use_distribution)) THEN
1240 : CALL dbcsr_transposed_prv(transposed%dbcsr, normal%dbcsr, &
1241 : shallow_data_copy=shallow_data_copy, &
1242 : transpose_distribution=transpose_distribution, &
1243 92770 : use_distribution=use_distribution%dbcsr)
1244 : ELSE
1245 : CALL dbcsr_transposed_prv(transposed%dbcsr, normal%dbcsr, &
1246 : shallow_data_copy=shallow_data_copy, &
1247 84008 : transpose_distribution=transpose_distribution)
1248 : END IF
1249 : ELSE
1250 : CPABORT("Not yet implemented for DBM.")
1251 : END IF
1252 176778 : END SUBROUTINE dbcsr_transposed
1253 :
1254 : ! **************************************************************************************************
1255 : !> \brief ...
1256 : !> \param matrix ...
1257 : !> \return ...
1258 : ! **************************************************************************************************
1259 1523729 : FUNCTION dbcsr_valid_index(matrix) RESULT(valid_index)
1260 : TYPE(dbcsr_type), INTENT(IN) :: matrix
1261 : LOGICAL :: valid_index
1262 :
1263 1523729 : IF (USE_DBCSR_BACKEND) THEN
1264 : valid_index = dbcsr_valid_index_prv(matrix%dbcsr)
1265 : ELSE
1266 : valid_index = .TRUE. ! Does not apply to DBM.
1267 : END IF
1268 1523729 : END FUNCTION dbcsr_valid_index
1269 :
1270 : ! **************************************************************************************************
1271 : !> \brief ...
1272 : !> \param matrix ...
1273 : !> \param verbosity ...
1274 : !> \param local ...
1275 : ! **************************************************************************************************
1276 196184 : SUBROUTINE dbcsr_verify_matrix(matrix, verbosity, local)
1277 : TYPE(dbcsr_type), INTENT(IN) :: matrix
1278 : INTEGER, INTENT(IN), OPTIONAL :: verbosity
1279 : LOGICAL, INTENT(IN), OPTIONAL :: local
1280 :
1281 196184 : IF (USE_DBCSR_BACKEND) THEN
1282 : CALL dbcsr_verify_matrix_prv(matrix%dbcsr, verbosity, local)
1283 : ELSE
1284 : ! Does not apply to DBM.
1285 : END IF
1286 196184 : END SUBROUTINE dbcsr_verify_matrix
1287 :
1288 : ! **************************************************************************************************
1289 : !> \brief ...
1290 : !> \param matrix ...
1291 : !> \param nblks_guess ...
1292 : !> \param sizedata_guess ...
1293 : !> \param n ...
1294 : !> \param work_mutable ...
1295 : ! **************************************************************************************************
1296 6250 : SUBROUTINE dbcsr_work_create(matrix, nblks_guess, sizedata_guess, n, work_mutable)
1297 : TYPE(dbcsr_type), INTENT(INOUT) :: matrix
1298 : INTEGER, INTENT(IN), OPTIONAL :: nblks_guess, sizedata_guess, n
1299 : LOGICAL, INTENT(in), OPTIONAL :: work_mutable
1300 :
1301 6250 : IF (USE_DBCSR_BACKEND) THEN
1302 : CALL dbcsr_work_create_prv(matrix%dbcsr, nblks_guess, sizedata_guess, n, work_mutable)
1303 : ELSE
1304 : ! Does not apply to DBM.
1305 : END IF
1306 6250 : END SUBROUTINE dbcsr_work_create
1307 :
1308 : ! **************************************************************************************************
1309 : !> \brief ...
1310 : !> \param matrix_a ...
1311 : !> \param matrix_b ...
1312 : !> \param RESULT ...
1313 : ! **************************************************************************************************
1314 42917 : SUBROUTINE dbcsr_dot_threadsafe(matrix_a, matrix_b, RESULT)
1315 : TYPE(dbcsr_type), INTENT(IN) :: matrix_a, matrix_b
1316 : REAL(kind=dp), INTENT(INOUT) :: result
1317 :
1318 42917 : IF (USE_DBCSR_BACKEND) THEN
1319 : CALL dbcsr_dot_prv(matrix_a%dbcsr, matrix_b%dbcsr, RESULT)
1320 : ELSE
1321 : CPABORT("Not yet implemented for DBM.")
1322 : END IF
1323 42917 : END SUBROUTINE dbcsr_dot_threadsafe
1324 :
1325 0 : END MODULE cp_dbcsr_api
|
