diff --git a/src/dbx/cp_dbcsr_api.F b/src/dbx/cp_dbcsr_api.F index 406081bf62..fbb395400e 100644 --- a/src/dbx/cp_dbcsr_api.F +++ b/src/dbx/cp_dbcsr_api.F @@ -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