mirror of
https://github.com/cp2k/cp2k.git
synced 2026-07-27 13:45:19 -04:00
DBX: Start adding DBM backend to cp_dbcsr_api
This commit is contained in:
Ole Schütt
Ole Schütt
parent
4134430067
commit
fe83ffd439
1 changed files with 418 additions and 136 deletions
|
|
@ -63,6 +63,9 @@ MODULE cp_dbcsr_api
|
|||
dbcsr_type_no_symmetry, dbcsr_type_prv => dbcsr_type, dbcsr_type_real_8, &
|
||||
dbcsr_type_real_default, dbcsr_type_symmetric, dbcsr_valid_index_prv => dbcsr_valid_index, &
|
||||
dbcsr_verify_matrix_prv => dbcsr_verify_matrix, dbcsr_work_create_prv => dbcsr_work_create
|
||||
USE dbm_api, ONLY: &
|
||||
dbm_add, dbm_checksum, dbm_clear, dbm_copy, dbm_distribution_obj, dbm_iterator, &
|
||||
dbm_redistribute, dbm_scale, dbm_type, dbm_zero
|
||||
USE kinds, ONLY: dp,&
|
||||
int_8
|
||||
USE message_passing, ONLY: mp_comm_type
|
||||
|
|
@ -203,21 +206,29 @@ MODULE cp_dbcsr_api
|
|||
END TYPE
|
||||
|
||||
TYPE dbcsr_type
|
||||
TYPE(dbcsr_type_prv), PRIVATE :: prv = dbcsr_type_prv()
|
||||
PRIVATE
|
||||
TYPE(dbcsr_type_prv) :: dbcsr = dbcsr_type_prv()
|
||||
TYPE(dbm_type) :: dbm = dbm_type()
|
||||
END TYPE dbcsr_type
|
||||
|
||||
TYPE dbcsr_distribution_type
|
||||
TYPE(dbcsr_distribution_type_prv), PRIVATE :: prv = dbcsr_distribution_type_prv()
|
||||
PRIVATE
|
||||
TYPE(dbcsr_distribution_type_prv) :: dbcsr = dbcsr_distribution_type_prv()
|
||||
TYPE(dbm_distribution_obj) :: dbm = dbm_distribution_obj()
|
||||
END TYPE dbcsr_distribution_type
|
||||
|
||||
TYPE dbcsr_iterator_type
|
||||
TYPE(dbcsr_iterator_type_prv), PRIVATE :: prv = dbcsr_iterator_type_prv()
|
||||
PRIVATE
|
||||
TYPE(dbcsr_iterator_type_prv) :: dbcsr = dbcsr_iterator_type_prv()
|
||||
TYPE(dbm_iterator) :: dbm = dbm_iterator()
|
||||
END TYPE dbcsr_iterator_type
|
||||
|
||||
INTERFACE dbcsr_create
|
||||
MODULE PROCEDURE dbcsr_create_new, dbcsr_create_template
|
||||
END INTERFACE
|
||||
|
||||
LOGICAL, PARAMETER, PRIVATE :: USE_DBCSR_BACKEND = .TRUE.
|
||||
|
||||
CONTAINS
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -275,7 +286,12 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(IN) :: matrix_b
|
||||
REAL(kind=dp), INTENT(IN) :: alpha_scalar, beta_scalar
|
||||
|
||||
CALL dbcsr_add_prv(matrix_a%prv, matrix_b%prv, alpha_scalar, beta_scalar)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_add_prv(matrix_a%dbcsr, matrix_b%dbcsr, alpha_scalar, beta_scalar)
|
||||
ELSE
|
||||
IF (alpha_scalar /= 1.0_dp .OR. beta_scalar /= 1.0_dp) CPABORT("Not yet implemented for DBM.")
|
||||
CALL dbm_add(matrix_a%dbm, matrix_b%dbm)
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_add
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -290,7 +306,11 @@ CONTAINS
|
|||
INTEGER, INTENT(IN) :: block_row, block_col
|
||||
REAL(KIND=dp), DIMENSION(:, :), POINTER :: block
|
||||
|
||||
CALL dbcsr_add_block_node_prv(matrix%prv, block_row, block_col, block)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_add_block_node_prv(matrix%dbcsr, block_row, block_col, block)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_add_block_node
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -302,7 +322,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
|
||||
REAL(kind=dp), INTENT(IN) :: alpha_scalar
|
||||
|
||||
CALL dbcsr_add_on_diag_prv(matrix%prv, alpha_scalar)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_add_on_diag_prv(matrix%dbcsr, alpha_scalar)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_add_on_diag
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -316,7 +340,11 @@ CONTAINS
|
|||
TYPE(dbcsr_distribution_type), INTENT(IN) :: distribution
|
||||
TYPE(dbcsr_type), INTENT(INOUT) :: matrix_new
|
||||
|
||||
CALL dbcsr_binary_read_prv(filepath, distribution%prv, matrix_new%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_binary_read_prv(filepath, distribution%dbcsr, matrix_new%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_binary_read
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -328,7 +356,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
|
||||
CHARACTER(LEN=*), INTENT(IN) :: filepath
|
||||
|
||||
CALL dbcsr_binary_write_prv(matrix%prv, filepath)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_binary_write_prv(matrix%dbcsr, filepath)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_binary_write
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -342,7 +374,12 @@ CONTAINS
|
|||
LOGICAL, INTENT(IN), OPTIONAL :: pos
|
||||
REAL(KIND=dp) :: checksum
|
||||
|
||||
checksum = dbcsr_checksum_prv(matrix%prv, pos=pos)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
checksum = dbcsr_checksum_prv(matrix%dbcsr, pos=pos)
|
||||
ELSE
|
||||
IF (PRESENT(pos)) CPABORT("Not yet implemented for DBM.")
|
||||
checksum = dbm_checksum(matrix%dbm)
|
||||
END IF
|
||||
END FUNCTION dbcsr_checksum
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -352,7 +389,11 @@ CONTAINS
|
|||
SUBROUTINE dbcsr_clear(matrix)
|
||||
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
|
||||
|
||||
CALL dbcsr_clear_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_clear_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
CALL dbm_clear(matrix%dbm)
|
||||
END IF
|
||||
END SUBROUTINE
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -364,7 +405,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(IN) :: matrix
|
||||
TYPE(dbcsr_type), INTENT(INOUT) :: redist
|
||||
|
||||
CALL dbcsr_complete_redistribute_prv(matrix%prv, redist%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_complete_redistribute_prv(matrix%dbcsr, redist%dbcsr)
|
||||
ELSE
|
||||
CALL dbm_redistribute(matrix%dbm, redist%dbm)
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_complete_redistribute
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -376,7 +421,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(INOUT) :: dbcsr_mat
|
||||
TYPE(dbcsr_csr_type), INTENT(INOUT) :: csr_mat
|
||||
|
||||
CALL convert_csr_to_dbcsr_prv(dbcsr_mat%prv, csr_mat)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL convert_csr_to_dbcsr_prv(dbcsr_mat%dbcsr, csr_mat)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_convert_csr_to_dbcsr
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -388,7 +437,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(IN) :: dbcsr_mat
|
||||
TYPE(dbcsr_csr_type), INTENT(INOUT) :: csr_mat
|
||||
|
||||
CALL convert_dbcsr_to_csr_prv(dbcsr_mat%prv, csr_mat)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL convert_dbcsr_to_csr_prv(dbcsr_mat%dbcsr, csr_mat)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_convert_dbcsr_to_csr
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -405,8 +458,15 @@ CONTAINS
|
|||
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name
|
||||
LOGICAL, INTENT(IN), OPTIONAL :: keep_sparsity, keep_imaginary
|
||||
|
||||
CALL dbcsr_copy_prv(matrix_b%prv, matrix_a%prv, name=name, keep_sparsity=keep_sparsity, &
|
||||
keep_imaginary=keep_imaginary)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_copy_prv(matrix_b%dbcsr, matrix_a%dbcsr, name=name, &
|
||||
keep_sparsity=keep_sparsity, keep_imaginary=keep_imaginary)
|
||||
ELSE
|
||||
IF (PRESENT(name) .OR. PRESENT(keep_sparsity) .OR. PRESENT(keep_imaginary)) THEN
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
CALL dbm_copy(matrix_b%dbm, matrix_a%dbm)
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_copy
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -432,10 +492,14 @@ CONTAINS
|
|||
INTEGER, INTENT(IN), OPTIONAL :: nze, data_type
|
||||
LOGICAL, INTENT(IN), OPTIONAL :: reuse_arrays, mutable_work
|
||||
|
||||
CALL dbcsr_create_prv(matrix=matrix%prv, name=name, dist=dist%prv, matrix_type=matrix_type, &
|
||||
row_blk_size=row_blk_size, col_blk_size=col_blk_size, nze=nze, &
|
||||
data_type=data_type, reuse_arrays=reuse_arrays, &
|
||||
mutable_work=mutable_work)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_create_prv(matrix=matrix%dbcsr, name=name, dist=dist%dbcsr, &
|
||||
matrix_type=matrix_type, row_blk_size=row_blk_size, &
|
||||
col_blk_size=col_blk_size, nze=nze, data_type=data_type, &
|
||||
reuse_arrays=reuse_arrays, mutable_work=mutable_work)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_create_new
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -466,11 +530,15 @@ CONTAINS
|
|||
INTEGER, INTENT(IN), OPTIONAL :: nze, data_type
|
||||
LOGICAL, INTENT(IN), OPTIONAL :: reuse_arrays, mutable_work
|
||||
|
||||
CALL dbcsr_create_prv(matrix=matrix%prv, name=name, template=template%prv, dist=dist%prv, &
|
||||
matrix_type=matrix_type, &
|
||||
row_blk_size=row_blk_size, col_blk_size=col_blk_size, &
|
||||
nze=nze, data_type=data_type, reuse_arrays=reuse_arrays, &
|
||||
mutable_work=mutable_work)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_create_prv(matrix=matrix%dbcsr, name=name, template=template%dbcsr, &
|
||||
dist=dist%dbcsr, matrix_type=matrix_type, &
|
||||
row_blk_size=row_blk_size, col_blk_size=col_blk_size, &
|
||||
nze=nze, data_type=data_type, reuse_arrays=reuse_arrays, &
|
||||
mutable_work=mutable_work)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_create_template
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -489,11 +557,16 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(IN), OPTIONAL :: csr_sparsity
|
||||
INTEGER, INTENT(IN), OPTIONAL :: numnodes
|
||||
|
||||
IF (PRESENT(csr_sparsity)) THEN
|
||||
CALL dbcsr_csr_create_from_dbcsr_prv(dbcsr_mat%prv, csr_mat, dist_format, &
|
||||
csr_sparsity%prv, numnodes)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
IF (PRESENT(csr_sparsity)) THEN
|
||||
CALL dbcsr_csr_create_from_dbcsr_prv(dbcsr_mat%dbcsr, csr_mat, dist_format, &
|
||||
csr_sparsity%dbcsr, numnodes)
|
||||
ELSE
|
||||
CALL dbcsr_csr_create_from_dbcsr_prv(dbcsr_mat%dbcsr, csr_mat, &
|
||||
dist_format, numnodes=numnodes)
|
||||
END IF
|
||||
ELSE
|
||||
CALL dbcsr_csr_create_from_dbcsr_prv(dbcsr_mat%prv, csr_mat, dist_format, numnodes=numnodes)
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_csr_create_from_dbcsr
|
||||
|
||||
|
|
@ -514,16 +587,20 @@ CONTAINS
|
|||
|
||||
TYPE(dbcsr_type) :: cmatrix, tmp_matrix
|
||||
|
||||
CALL dbcsr_create_prv(tmp_matrix%prv, template=rmatrix%prv, data_type=dbcsr_type_complex_8)
|
||||
CALL dbcsr_create_prv(cmatrix%prv, template=rmatrix%prv, data_type=dbcsr_type_complex_8)
|
||||
CALL dbcsr_copy_prv(cmatrix%prv, rmatrix%prv)
|
||||
CALL dbcsr_copy_prv(tmp_matrix%prv, imatrix%prv)
|
||||
CALL dbcsr_add_prv(cmatrix%prv, tmp_matrix%prv, rone, ione)
|
||||
CALL dbcsr_release_prv(tmp_matrix%prv)
|
||||
! Convert to csr
|
||||
CALL dbcsr_csr_create_from_dbcsr_prv(cmatrix%prv, csr_mat, dist_format)
|
||||
CALL convert_dbcsr_to_csr_prv(cmatrix%prv, csr_mat)
|
||||
CALL dbcsr_release_prv(cmatrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_create_prv(tmp_matrix%dbcsr, template=rmatrix%dbcsr, data_type=dbcsr_type_complex_8)
|
||||
CALL dbcsr_create_prv(cmatrix%dbcsr, template=rmatrix%dbcsr, data_type=dbcsr_type_complex_8)
|
||||
CALL dbcsr_copy_prv(cmatrix%dbcsr, rmatrix%dbcsr)
|
||||
CALL dbcsr_copy_prv(tmp_matrix%dbcsr, imatrix%dbcsr)
|
||||
CALL dbcsr_add_prv(cmatrix%dbcsr, tmp_matrix%dbcsr, rone, ione)
|
||||
CALL dbcsr_release_prv(tmp_matrix%dbcsr)
|
||||
! Convert to csr
|
||||
CALL dbcsr_csr_create_from_dbcsr_prv(cmatrix%dbcsr, csr_mat, dist_format)
|
||||
CALL convert_dbcsr_to_csr_prv(cmatrix%dbcsr, csr_mat)
|
||||
CALL dbcsr_release_prv(cmatrix%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_csr_create_and_convert_complex
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -535,7 +612,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(IN) :: matrix_a
|
||||
TYPE(dbcsr_type), INTENT(INOUT) :: matrix_b
|
||||
|
||||
CALL dbcsr_desymmetrize_prv(matrix_a%prv, matrix_b%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_desymmetrize_prv(matrix_a%dbcsr, matrix_b%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_desymmetrize
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -545,7 +626,11 @@ CONTAINS
|
|||
SUBROUTINE dbcsr_distribute(matrix)
|
||||
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
|
||||
|
||||
CALL dbcsr_distribute_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_distribute_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_distribute
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -581,9 +666,13 @@ CONTAINS
|
|||
LOGICAL, INTENT(OUT), OPTIONAL :: subgroups_defined
|
||||
INTEGER, INTENT(OUT), OPTIONAL :: prow_group, pcol_group
|
||||
|
||||
CALL dbcsr_distribution_get_prv(dist%prv, row_dist, col_dist, nrows, ncols, has_threads, &
|
||||
group, mynode, numnodes, nprows, npcols, myprow, mypcol, &
|
||||
pgrid, subgroups_defined, prow_group, pcol_group)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_distribution_get_prv(dist%dbcsr, row_dist, col_dist, nrows, ncols, has_threads, &
|
||||
group, mynode, numnodes, nprows, npcols, myprow, mypcol, &
|
||||
pgrid, subgroups_defined, prow_group, pcol_group)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_distribution_get
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -593,7 +682,11 @@ CONTAINS
|
|||
SUBROUTINE dbcsr_distribution_hold(dist)
|
||||
TYPE(dbcsr_distribution_type) :: dist
|
||||
|
||||
CALL dbcsr_distribution_hold_prv(dist%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_distribution_hold_prv(dist%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_distribution_hold
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -615,8 +708,12 @@ CONTAINS
|
|||
INTEGER, DIMENSION(:), INTENT(INOUT), POINTER :: row_dist, col_dist
|
||||
LOGICAL, INTENT(IN), OPTIONAL :: reuse_arrays
|
||||
|
||||
CALL dbcsr_distribution_new_prv(dist%prv, template%prv, group, pgrid, &
|
||||
row_dist, col_dist, reuse_arrays)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_distribution_new_prv(dist%dbcsr, template%dbcsr, group, pgrid, &
|
||||
row_dist, col_dist, reuse_arrays)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_distribution_new
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -626,7 +723,11 @@ CONTAINS
|
|||
SUBROUTINE dbcsr_distribution_release(dist)
|
||||
TYPE(dbcsr_distribution_type) :: dist
|
||||
|
||||
CALL dbcsr_distribution_release_prv(dist%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_distribution_release_prv(dist%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_distribution_release
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -639,7 +740,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(IN) :: matrix_a, matrix_b
|
||||
REAL(kind=dp), INTENT(INOUT) :: result
|
||||
|
||||
CALL dbcsr_dot_prv(matrix_a%prv, matrix_b%prv, RESULT)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_dot_prv(matrix_a%dbcsr, matrix_b%dbcsr, RESULT)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_dot
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -651,7 +756,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
|
||||
REAL(dp), INTENT(IN) :: eps
|
||||
|
||||
CALL dbcsr_filter_prv(matrix%prv, eps)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_filter_prv(matrix%dbcsr, eps)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_filter
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -661,7 +770,11 @@ CONTAINS
|
|||
SUBROUTINE dbcsr_finalize(matrix)
|
||||
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
|
||||
|
||||
CALL dbcsr_finalize_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_finalize_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_finalize
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -673,7 +786,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(IN) :: matrix
|
||||
TYPE(dbcsr_type), INTENT(INOUT) :: diag
|
||||
|
||||
CALL dbcsr_get_block_diag_prv(matrix%prv, diag%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_get_block_diag_prv(matrix%dbcsr, diag%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_get_block_diag
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -693,7 +810,11 @@ CONTAINS
|
|||
LOGICAL, INTENT(OUT) :: found
|
||||
INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size
|
||||
|
||||
CALL dbcsr_get_block_p_prv(matrix%prv, row, col, block, found, row_size, col_size)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_get_block_p_prv(matrix%dbcsr, row, col, block, found, row_size, col_size)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_get_block_p
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -710,7 +831,11 @@ CONTAINS
|
|||
INTEGER, INTENT(IN), OPTIONAL :: lb, ub
|
||||
REAL(kind=dp), DIMENSION(:), POINTER :: res
|
||||
|
||||
res => dbcsr_get_data_p_prv(matrix%prv, select_data_type, lb, ub)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
res => dbcsr_get_data_p_prv(matrix%dbcsr, select_data_type, lb, ub)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END FUNCTION dbcsr_get_data_p
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -722,7 +847,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(IN) :: matrix
|
||||
INTEGER :: data_size
|
||||
|
||||
data_size = dbcsr_get_data_size_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
data_size = dbcsr_get_data_size_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END FUNCTION dbcsr_get_data_size
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -730,11 +859,15 @@ CONTAINS
|
|||
!> \param matrix ...
|
||||
!> \return ...
|
||||
! **************************************************************************************************
|
||||
PURE FUNCTION dbcsr_get_data_type(matrix) RESULT(data_type)
|
||||
FUNCTION dbcsr_get_data_type(matrix) RESULT(data_type)
|
||||
TYPE(dbcsr_type), INTENT(IN) :: matrix
|
||||
INTEGER :: data_type
|
||||
|
||||
data_type = dbcsr_get_data_type_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
data_type = dbcsr_get_data_type_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END FUNCTION dbcsr_get_data_type
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -746,7 +879,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(IN) :: matrix
|
||||
REAL(kind=dp), DIMENSION(:), INTENT(OUT) :: diag
|
||||
|
||||
CALL dbcsr_get_diag_prv(matrix%prv, diag)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_get_diag_prv(matrix%dbcsr, diag)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_get_diag
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -798,34 +935,37 @@ CONTAINS
|
|||
INTEGER :: group_handle
|
||||
TYPE(dbcsr_distribution_type_prv) :: my_distribution
|
||||
|
||||
CALL dbcsr_get_info_prv(matrix=matrix%prv, &
|
||||
nblkrows_total=nblkrows_total, &
|
||||
nblkcols_total=nblkcols_total, &
|
||||
nfullrows_total=nfullrows_total, &
|
||||
nfullcols_total=nfullcols_total, &
|
||||
nblkrows_local=nblkrows_local, &
|
||||
nblkcols_local=nblkcols_local, &
|
||||
nfullrows_local=nfullrows_local, &
|
||||
nfullcols_local=nfullcols_local, &
|
||||
my_prow=my_prow, &
|
||||
my_pcol=my_pcol, &
|
||||
local_rows=local_rows, &
|
||||
local_cols=local_cols, &
|
||||
proc_row_dist=proc_row_dist, &
|
||||
proc_col_dist=proc_col_dist, &
|
||||
row_blk_size=row_blk_size, &
|
||||
col_blk_size=col_blk_size, &
|
||||
row_blk_offset=row_blk_offset, &
|
||||
col_blk_offset=col_blk_offset, &
|
||||
distribution=my_distribution, &
|
||||
name=name, &
|
||||
matrix_type=matrix_type, &
|
||||
data_type=data_type, &
|
||||
group=group_handle)
|
||||
|
||||
IF (PRESENT(distribution)) distribution%prv = my_distribution
|
||||
IF (PRESENT(group)) CALL group%set_handle(group_handle)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_get_info_prv(matrix=matrix%dbcsr, &
|
||||
nblkrows_total=nblkrows_total, &
|
||||
nblkcols_total=nblkcols_total, &
|
||||
nfullrows_total=nfullrows_total, &
|
||||
nfullcols_total=nfullcols_total, &
|
||||
nblkrows_local=nblkrows_local, &
|
||||
nblkcols_local=nblkcols_local, &
|
||||
nfullrows_local=nfullrows_local, &
|
||||
nfullcols_local=nfullcols_local, &
|
||||
my_prow=my_prow, &
|
||||
my_pcol=my_pcol, &
|
||||
local_rows=local_rows, &
|
||||
local_cols=local_cols, &
|
||||
proc_row_dist=proc_row_dist, &
|
||||
proc_col_dist=proc_col_dist, &
|
||||
row_blk_size=row_blk_size, &
|
||||
col_blk_size=col_blk_size, &
|
||||
row_blk_offset=row_blk_offset, &
|
||||
col_blk_offset=col_blk_offset, &
|
||||
distribution=my_distribution, &
|
||||
name=name, &
|
||||
matrix_type=matrix_type, &
|
||||
data_type=data_type, &
|
||||
group=group_handle)
|
||||
|
||||
IF (PRESENT(distribution)) distribution%dbcsr = my_distribution
|
||||
IF (PRESENT(group)) CALL group%set_handle(group_handle)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_get_info
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -833,11 +973,15 @@ CONTAINS
|
|||
!> \param matrix ...
|
||||
!> \return ...
|
||||
! **************************************************************************************************
|
||||
PURE FUNCTION dbcsr_get_matrix_type(matrix) RESULT(matrix_type)
|
||||
FUNCTION dbcsr_get_matrix_type(matrix) RESULT(matrix_type)
|
||||
TYPE(dbcsr_type), INTENT(IN) :: matrix
|
||||
CHARACTER :: matrix_type
|
||||
|
||||
matrix_type = dbcsr_get_matrix_type_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
matrix_type = dbcsr_get_matrix_type_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END FUNCTION dbcsr_get_matrix_type
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -845,11 +989,15 @@ CONTAINS
|
|||
!> \param matrix ...
|
||||
!> \return ...
|
||||
! **************************************************************************************************
|
||||
PURE FUNCTION dbcsr_get_num_blocks(matrix) RESULT(num_blocks)
|
||||
FUNCTION dbcsr_get_num_blocks(matrix) RESULT(num_blocks)
|
||||
TYPE(dbcsr_type), INTENT(IN) :: matrix
|
||||
INTEGER :: num_blocks
|
||||
|
||||
num_blocks = dbcsr_get_num_blocks_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
num_blocks = dbcsr_get_num_blocks_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END FUNCTION dbcsr_get_num_blocks
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -861,7 +1009,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(IN) :: matrix
|
||||
REAL(KIND=dp) :: occupation
|
||||
|
||||
occupation = dbcsr_get_occupation_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
occupation = dbcsr_get_occupation_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END FUNCTION dbcsr_get_occupation
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -876,7 +1028,11 @@ CONTAINS
|
|||
INTEGER, INTENT(IN) :: row, column
|
||||
INTEGER, INTENT(OUT) :: processor
|
||||
|
||||
CALL dbcsr_get_stored_coordinates_prv(matrix%prv, row, column, processor)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_get_stored_coordinates_prv(matrix%dbcsr, row, column, processor)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_get_stored_coordinates
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -884,11 +1040,15 @@ CONTAINS
|
|||
!> \param matrix ...
|
||||
!> \return ...
|
||||
! **************************************************************************************************
|
||||
PURE FUNCTION dbcsr_has_symmetry(matrix) RESULT(has_symmetry)
|
||||
FUNCTION dbcsr_has_symmetry(matrix) RESULT(has_symmetry)
|
||||
TYPE(dbcsr_type), INTENT(IN) :: matrix
|
||||
LOGICAL :: has_symmetry
|
||||
|
||||
has_symmetry = dbcsr_has_symmetry_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
has_symmetry = dbcsr_has_symmetry_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END FUNCTION dbcsr_has_symmetry
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -896,11 +1056,15 @@ CONTAINS
|
|||
!> \param iterator ...
|
||||
!> \return ...
|
||||
! **************************************************************************************************
|
||||
PURE FUNCTION dbcsr_iterator_blocks_left(iterator) RESULT(blocks_left)
|
||||
FUNCTION dbcsr_iterator_blocks_left(iterator) RESULT(blocks_left)
|
||||
TYPE(dbcsr_iterator_type), INTENT(IN) :: iterator
|
||||
LOGICAL :: blocks_left
|
||||
|
||||
blocks_left = dbcsr_iterator_blocks_left_prv(iterator%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
blocks_left = dbcsr_iterator_blocks_left_prv(iterator%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END FUNCTION dbcsr_iterator_blocks_left
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -931,12 +1095,16 @@ CONTAINS
|
|||
|
||||
CPASSERT(.NOT. PRESENT(block_number_argument_has_been_removed))
|
||||
|
||||
CALL dbcsr_iterator_next_block_prv(iterator%prv, row=my_row, column=my_column, block=my_block, &
|
||||
row_size=row_size, col_size=col_size, &
|
||||
row_offset=row_offset, col_offset=col_offset)
|
||||
IF (PRESENT(block)) block => my_block
|
||||
IF (PRESENT(row)) row = my_row
|
||||
IF (PRESENT(column)) column = my_column
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_iterator_next_block_prv(iterator%dbcsr, row=my_row, column=my_column, &
|
||||
block=my_block, row_size=row_size, col_size=col_size, &
|
||||
row_offset=row_offset, col_offset=col_offset)
|
||||
IF (PRESENT(block)) block => my_block
|
||||
IF (PRESENT(row)) row = my_row
|
||||
IF (PRESENT(column)) column = my_column
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_iterator_next_block
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -954,8 +1122,12 @@ CONTAINS
|
|||
LOGICAL, INTENT(IN), OPTIONAL :: shared, dynamic, dynamic_byrows, &
|
||||
read_only
|
||||
|
||||
CALL dbcsr_iterator_start_prv(iterator%prv, matrix%prv, shared, dynamic, dynamic_byrows, &
|
||||
read_only)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_iterator_start_prv(iterator%dbcsr, matrix%dbcsr, shared, dynamic, &
|
||||
dynamic_byrows, read_only)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_iterator_start
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -965,7 +1137,11 @@ CONTAINS
|
|||
SUBROUTINE dbcsr_iterator_stop(iterator)
|
||||
TYPE(dbcsr_iterator_type), INTENT(INOUT) :: iterator
|
||||
|
||||
CALL dbcsr_iterator_stop_prv(iterator%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_iterator_stop_prv(iterator%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_iterator_stop
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -975,7 +1151,11 @@ CONTAINS
|
|||
SUBROUTINE dbcsr_mp_grid_setup(dist)
|
||||
TYPE(dbcsr_distribution_type), INTENT(INOUT) :: dist
|
||||
|
||||
CALL dbcsr_mp_grid_setup_prv(dist%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_mp_grid_setup_prv(dist%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_mp_grid_setup
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1012,9 +1192,13 @@ CONTAINS
|
|||
REAL(kind=dp), INTENT(IN), OPTIONAL :: filter_eps
|
||||
INTEGER(int_8), INTENT(OUT), OPTIONAL :: flop
|
||||
|
||||
CALL dbcsr_multiply_prv(transa, transb, alpha, matrix_a%prv, matrix_b%prv, beta, &
|
||||
matrix_c%prv, first_row, last_row, first_column, last_column, &
|
||||
first_k, last_k, retain_sparsity, filter_eps=filter_eps, flop=flop)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_multiply_prv(transa, transb, alpha, matrix_a%dbcsr, matrix_b%dbcsr, beta, &
|
||||
matrix_c%dbcsr, first_row, last_row, first_column, last_column, &
|
||||
first_k, last_k, retain_sparsity, filter_eps=filter_eps, flop=flop)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_multiply
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1026,7 +1210,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(IN) :: matrix
|
||||
INTEGER :: nblkcols_total
|
||||
|
||||
nblkcols_total = dbcsr_nblkcols_total_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
nblkcols_total = dbcsr_nblkcols_total_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END FUNCTION dbcsr_nblkcols_total
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1038,7 +1226,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(IN) :: matrix
|
||||
INTEGER :: nblkrows_total
|
||||
|
||||
nblkrows_total = dbcsr_nblkrows_total_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
nblkrows_total = dbcsr_nblkrows_total_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END FUNCTION dbcsr_nblkrows_total
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1050,7 +1242,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(IN) :: matrix
|
||||
INTEGER :: nfullcols_total
|
||||
|
||||
nfullcols_total = dbcsr_nfullcols_total_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
nfullcols_total = dbcsr_nfullcols_total_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END FUNCTION dbcsr_nfullcols_total
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1062,7 +1258,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(IN) :: matrix
|
||||
INTEGER :: nfullrows_total
|
||||
|
||||
nfullrows_total = dbcsr_nfullrows_total_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
nfullrows_total = dbcsr_nfullrows_total_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END FUNCTION dbcsr_nfullrows_total
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1079,7 +1279,11 @@ CONTAINS
|
|||
CHARACTER(*), INTENT(in), OPTIONAL :: variable_name
|
||||
INTEGER, OPTIONAL :: unit_nr
|
||||
|
||||
CALL dbcsr_print_prv(matrix%prv, nodata, matlab_format, variable_name, unit_nr)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_print_prv(matrix%dbcsr, nodata, matlab_format, variable_name, unit_nr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_print
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1091,7 +1295,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(IN) :: matrix
|
||||
INTEGER, OPTIONAL :: unit_nr
|
||||
|
||||
CALL dbcsr_print_block_sum_prv(matrix%prv, unit_nr)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_print_block_sum_prv(matrix%dbcsr, unit_nr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_print_block_sum
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1108,7 +1316,11 @@ CONTAINS
|
|||
REAL(kind=dp), DIMENSION(:, :), INTENT(IN) :: block
|
||||
LOGICAL, INTENT(IN), OPTIONAL :: summation
|
||||
|
||||
CALL dbcsr_put_block_prv(matrix%prv, row, col, block, summation=summation)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_put_block_prv(matrix%dbcsr, row, col, block, summation=summation)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_put_block
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1118,7 +1330,11 @@ CONTAINS
|
|||
SUBROUTINE dbcsr_release(matrix)
|
||||
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
|
||||
|
||||
CALL dbcsr_release_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_release_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_release
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1128,7 +1344,11 @@ CONTAINS
|
|||
SUBROUTINE dbcsr_replicate_all(matrix)
|
||||
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
|
||||
|
||||
CALL dbcsr_replicate_all_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_replicate_all_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_replicate_all
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1138,7 +1358,11 @@ CONTAINS
|
|||
SUBROUTINE dbcsr_reserve_all_blocks(matrix)
|
||||
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
|
||||
|
||||
CALL dbcsr_reserve_all_blocks_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_reserve_all_blocks_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_reserve_all_blocks
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1153,7 +1377,11 @@ CONTAINS
|
|||
INTEGER, INTENT(IN) :: row, col
|
||||
REAL(kind=dp), DIMENSION(:, :), POINTER :: block
|
||||
|
||||
CALL dbcsr_reserve_block2d_prv(matrix%prv, row, col, block)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_reserve_block2d_prv(matrix%dbcsr, row, col, block)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_reserve_block2d
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1166,7 +1394,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
|
||||
INTEGER, DIMENSION(:), INTENT(IN) :: rows, cols
|
||||
|
||||
CALL dbcsr_reserve_blocks_prv(matrix%prv, rows, cols)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_reserve_blocks_prv(matrix%dbcsr, rows, cols)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_reserve_blocks
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1176,7 +1408,11 @@ CONTAINS
|
|||
SUBROUTINE dbcsr_reserve_diag_blocks(matrix)
|
||||
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
|
||||
|
||||
CALL dbcsr_reserve_diag_blocks_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_reserve_diag_blocks_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_reserve_diag_blocks
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1188,7 +1424,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
|
||||
REAL(kind=dp), INTENT(IN) :: alpha_scalar
|
||||
|
||||
CALL dbcsr_scale_prv(matrix%prv, alpha_scalar)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_scale_prv(matrix%dbcsr, alpha_scalar)
|
||||
ELSE
|
||||
CALL dbm_scale(matrix%dbm, alpha_scalar)
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_scale
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1202,7 +1442,11 @@ CONTAINS
|
|||
REAL(kind=dp), DIMENSION(:), INTENT(IN), TARGET :: alpha
|
||||
CHARACTER(LEN=*), INTENT(IN) :: side
|
||||
|
||||
CALL dbcsr_scale_by_vector_prv(matrix%prv, alpha, side)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_scale_by_vector_prv(matrix%dbcsr, alpha, side)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_scale_by_vector
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1214,7 +1458,15 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
|
||||
REAL(kind=dp), INTENT(IN) :: alpha
|
||||
|
||||
CALL dbcsr_set_prv(matrix%prv, alpha)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_set_prv(matrix%dbcsr, alpha)
|
||||
ELSE
|
||||
IF (alpha == 0.0_dp) THEN
|
||||
CALL dbm_zero(matrix%dbm)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_set
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1226,7 +1478,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
|
||||
REAL(kind=dp), DIMENSION(:), INTENT(IN) :: diag
|
||||
|
||||
CALL dbcsr_set_diag_prv(matrix%prv, diag)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_set_diag_prv(matrix%dbcsr, diag)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_set_diag
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1236,7 +1492,11 @@ CONTAINS
|
|||
SUBROUTINE dbcsr_sum_replicated(matrix)
|
||||
TYPE(dbcsr_type), INTENT(inout) :: matrix
|
||||
|
||||
CALL dbcsr_sum_replicated_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_sum_replicated_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_sum_replicated
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1248,7 +1508,11 @@ CONTAINS
|
|||
TYPE(dbcsr_type), INTENT(IN) :: matrix
|
||||
REAL(kind=dp), INTENT(OUT) :: trace
|
||||
|
||||
CALL dbcsr_trace_prv(matrix%prv, trace)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_trace_prv(matrix%dbcsr, trace)
|
||||
ELSE
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_trace
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1267,13 +1531,19 @@ CONTAINS
|
|||
TYPE(dbcsr_distribution_type), INTENT(IN), &
|
||||
OPTIONAL :: use_distribution
|
||||
|
||||
IF (PRESENT(use_distribution)) THEN
|
||||
CALL dbcsr_transposed_prv(transposed%prv, normal%prv, shallow_data_copy=shallow_data_copy, &
|
||||
transpose_distribution=transpose_distribution, &
|
||||
use_distribution=use_distribution%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
IF (PRESENT(use_distribution)) THEN
|
||||
CALL dbcsr_transposed_prv(transposed%dbcsr, normal%dbcsr, &
|
||||
shallow_data_copy=shallow_data_copy, &
|
||||
transpose_distribution=transpose_distribution, &
|
||||
use_distribution=use_distribution%dbcsr)
|
||||
ELSE
|
||||
CALL dbcsr_transposed_prv(transposed%dbcsr, normal%dbcsr, &
|
||||
shallow_data_copy=shallow_data_copy, &
|
||||
transpose_distribution=transpose_distribution)
|
||||
END IF
|
||||
ELSE
|
||||
CALL dbcsr_transposed_prv(transposed%prv, normal%prv, shallow_data_copy=shallow_data_copy, &
|
||||
transpose_distribution=transpose_distribution)
|
||||
CPABORT("Not yet implemented for DBM.")
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_transposed
|
||||
|
||||
|
|
@ -1282,11 +1552,15 @@ CONTAINS
|
|||
!> \param matrix ...
|
||||
!> \return ...
|
||||
! **************************************************************************************************
|
||||
PURE FUNCTION dbcsr_valid_index(matrix) RESULT(valid_index)
|
||||
FUNCTION dbcsr_valid_index(matrix) RESULT(valid_index)
|
||||
TYPE(dbcsr_type), INTENT(IN) :: matrix
|
||||
LOGICAL :: valid_index
|
||||
|
||||
valid_index = dbcsr_valid_index_prv(matrix%prv)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
valid_index = dbcsr_valid_index_prv(matrix%dbcsr)
|
||||
ELSE
|
||||
valid_index = .TRUE. ! Does not apply to DBM.
|
||||
END IF
|
||||
END FUNCTION dbcsr_valid_index
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1300,7 +1574,11 @@ CONTAINS
|
|||
INTEGER, INTENT(IN), OPTIONAL :: verbosity
|
||||
LOGICAL, INTENT(IN), OPTIONAL :: local
|
||||
|
||||
CALL dbcsr_verify_matrix_prv(matrix%prv, verbosity, local)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_verify_matrix_prv(matrix%dbcsr, verbosity, local)
|
||||
ELSE
|
||||
! Does not apply to DBM.
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_verify_matrix
|
||||
|
||||
! **************************************************************************************************
|
||||
|
|
@ -1316,7 +1594,11 @@ CONTAINS
|
|||
INTEGER, INTENT(IN), OPTIONAL :: nblks_guess, sizedata_guess, n
|
||||
LOGICAL, INTENT(in), OPTIONAL :: work_mutable
|
||||
|
||||
CALL dbcsr_work_create_prv(matrix%prv, nblks_guess, sizedata_guess, n, work_mutable)
|
||||
IF (USE_DBCSR_BACKEND) THEN
|
||||
CALL dbcsr_work_create_prv(matrix%dbcsr, nblks_guess, sizedata_guess, n, work_mutable)
|
||||
ELSE
|
||||
! Does not apply to DBM.
|
||||
END IF
|
||||
END SUBROUTINE dbcsr_work_create
|
||||
|
||||
END MODULE cp_dbcsr_api
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue