From 7bc5a5b6eca4b52d79eb8178c87e25dce26cd95c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ole=20Sch=C3=BCtt?= Date: Thu, 20 Feb 2025 23:29:53 +0100 Subject: [PATCH] DBX: Add dbcsr_iterator_readonly_start and mark original INTENT(INOUT) --- src/almo_scf_methods.F | 10 ++++----- src/cp_dbcsr_operations.F | 21 +++++++++--------- src/ct_methods.F | 9 ++++---- src/dbx/cp_dbcsr_api.F | 34 ++++++++++++++++++++++++------ src/dbx/cp_dbcsr_contrib.F | 12 +++++------ src/et_coupling_proj.F | 3 ++- src/mp2_cphf.F | 12 +++++++---- src/mscfg_types.F | 4 ++-- src/optimize_embedding_potential.F | 2 +- src/qs_dcdr_utils.F | 3 ++- src/qs_fb_env_methods.F | 11 +++++----- src/qs_linres_kernel.F | 3 ++- src/qs_linres_methods.F | 7 ++++-- src/qs_moments.F | 2 +- src/qs_ot_eigensolver.F | 2 +- src/qs_p_env_methods.F | 3 ++- src/qs_scf_methods.F | 7 +++--- src/qs_tddfpt2_densities.F | 3 ++- src/qs_tddfpt2_eigensolver.F | 5 +++-- src/qs_tddfpt2_fhxc.F | 6 ++++-- src/qs_tddfpt2_forces.F | 4 ++-- src/qs_tddfpt2_operators.F | 9 +++++--- src/qs_tddfpt2_restart.F | 4 ++-- src/qs_tddfpt2_stda_utils.F | 8 ++++--- src/qs_tddfpt_utils.F | 3 ++- src/rpa_gw_im_time_util.F | 13 ++++++------ src/rpa_gw_kpoints_util.F | 2 +- src/rpa_rse.F | 5 +++-- src/rpa_util.F | 5 +++-- src/submatrix_dissection.F | 8 +++---- src/xas_tdp_atom.F | 11 +++++----- src/xas_tdp_utils.F | 2 +- 32 files changed, 139 insertions(+), 94 deletions(-) diff --git a/src/almo_scf_methods.F b/src/almo_scf_methods.F index eb491eb139..8e53ed31f0 100644 --- a/src/almo_scf_methods.F +++ b/src/almo_scf_methods.F @@ -22,10 +22,10 @@ MODULE almo_scf_methods USE cp_dbcsr_api, ONLY: & dbcsr_add, dbcsr_copy, dbcsr_create, dbcsr_distribution_get, dbcsr_distribution_type, & dbcsr_filter, dbcsr_finalize, dbcsr_get_diag, dbcsr_get_info, dbcsr_iterator_blocks_left, & - dbcsr_iterator_next_block, dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, & - dbcsr_multiply, dbcsr_print, dbcsr_put_block, dbcsr_release, dbcsr_scale_by_vector, & - dbcsr_set, dbcsr_set_diag, dbcsr_transposed, dbcsr_type, dbcsr_type_no_symmetry, & - dbcsr_type_symmetric, dbcsr_work_create + dbcsr_iterator_next_block, dbcsr_iterator_readonly_start, dbcsr_iterator_start, & + dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_multiply, dbcsr_print, dbcsr_put_block, & + dbcsr_release, dbcsr_scale_by_vector, dbcsr_set, dbcsr_set_diag, dbcsr_transposed, & + dbcsr_type, dbcsr_type_no_symmetry, dbcsr_type_symmetric, dbcsr_work_create USE cp_dbcsr_cholesky, ONLY: cp_dbcsr_cholesky_decompose,& cp_dbcsr_cholesky_invert USE cp_dbcsr_contrib, ONLY: dbcsr_add_on_diag,& @@ -1091,7 +1091,7 @@ CONTAINS CALL dbcsr_create(matrix_out, template=matrix_in) CALL dbcsr_work_create(matrix_out, work_mutable=.TRUE.) - CALL dbcsr_iterator_start(iter, matrix_in) + CALL dbcsr_iterator_readonly_start(iter, matrix_in) DO WHILE (dbcsr_iterator_blocks_left(iter)) diff --git a/src/cp_dbcsr_operations.F b/src/cp_dbcsr_operations.F index 29b3da70bd..f849f59d41 100644 --- a/src/cp_dbcsr_operations.F +++ b/src/cp_dbcsr_operations.F @@ -22,10 +22,10 @@ MODULE cp_dbcsr_operations dbcsr_create, dbcsr_deallocate_matrix, dbcsr_desymmetrize, dbcsr_distribution_get, & dbcsr_distribution_new, dbcsr_distribution_release, dbcsr_distribution_type, & dbcsr_get_info, dbcsr_get_matrix_type, dbcsr_iterator_blocks_left, & - dbcsr_iterator_next_block, dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, & - dbcsr_multiply, dbcsr_p_type, dbcsr_release, dbcsr_scale, dbcsr_type, & - dbcsr_type_antisymmetric, dbcsr_type_no_symmetry, dbcsr_type_symmetric, dbcsr_valid_index, & - dbcsr_verify_matrix + dbcsr_iterator_next_block, dbcsr_iterator_readonly_start, dbcsr_iterator_start, & + dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_multiply, dbcsr_p_type, dbcsr_release, & + dbcsr_scale, dbcsr_type, dbcsr_type_antisymmetric, dbcsr_type_no_symmetry, & + dbcsr_type_symmetric, dbcsr_valid_index, dbcsr_verify_matrix USE cp_dbcsr_contrib, ONLY: dbcsr_frobenius_norm,& dbcsr_reserve_all_blocks USE cp_fm_basic_linalg, ONLY: cp_fm_gemm @@ -212,7 +212,7 @@ CONTAINS ! ************************************************************************************************** SUBROUTINE copy_dbcsr_to_fm(matrix, fm) TYPE(dbcsr_type), INTENT(IN) :: matrix - TYPE(cp_fm_type), INTENT(IN) :: fm + TYPE(cp_fm_type), INTENT(INOUT) :: fm CHARACTER(LEN=*), PARAMETER :: routineN = 'copy_dbcsr_to_fm' @@ -273,7 +273,7 @@ CONTAINS ! ************************************************************************************************** SUBROUTINE copy_dbcsr_to_fm_bc(bc_mat, fm) TYPE(dbcsr_type), INTENT(IN) :: bc_mat - TYPE(cp_fm_type), INTENT(IN) :: fm + TYPE(cp_fm_type), INTENT(INOUT) :: fm CHARACTER(LEN=*), PARAMETER :: routineN = 'copy_dbcsr_to_fm_bc' @@ -293,7 +293,7 @@ CONTAINS fm_block = REAL(0.0, KIND=dp) !$OMP PARALLEL DEFAULT(NONE) PRIVATE(iter, row, col, dbcsr_block) & !$OMP SHARED(bc_mat, last_row, first_row, last_col, first_col, fm_block) - CALL dbcsr_iterator_start(iter, bc_mat) + CALL dbcsr_iterator_readonly_start(iter, bc_mat) DO WHILE (dbcsr_iterator_blocks_left(iter)) CALL dbcsr_iterator_next_block(iter, row, col, dbcsr_block) fm_block(first_row(row):last_row(row), first_col(col):last_col(col)) = dbcsr_block(:, :) @@ -488,7 +488,7 @@ CONTAINS !$OMP PARALLEL DEFAULT(NONE) SHARED(matrix_a,vec_b,vec_c,ncol,my_alpha2,my_alpha,my_ncol,has_symm) & !$OMP PRIVATE(iter,row,col,data_d,rowoff,coloff) - CALL dbcsr_iterator_start(iter, matrix_a, read_only=.TRUE., dynamic=.TRUE., dynamic_byrows=.TRUE.) + CALL dbcsr_iterator_readonly_start(iter, matrix_a, dynamic=.TRUE., dynamic_byrows=.TRUE.) DO WHILE (dbcsr_iterator_blocks_left(iter)) CALL dbcsr_iterator_next_block(iter, row, col, data_d, row_offset=rowoff, col_offset=coloff) IF (my_ncol .NE. 1) THEN @@ -510,7 +510,7 @@ CONTAINS ! FIXME ... in the symmetric case, the writes to vec_c depend on the column, not the row. This makes OMP-ing more difficult ! needs e.g. a buffer for vec_c and a reduction of that buffer. IF (has_symm) THEN - CALL dbcsr_iterator_start(iter, matrix_a) + CALL dbcsr_iterator_readonly_start(iter, matrix_a) DO WHILE (dbcsr_iterator_blocks_left(iter)) CALL dbcsr_iterator_next_block(iter, row, col, data_d, row_offset=rowoff, col_offset=coloff) IF (row .NE. col) THEN @@ -550,7 +550,8 @@ CONTAINS ! ************************************************************************************************** SUBROUTINE cp_dbcsr_sm_fm_multiply(matrix, fm_in, fm_out, ncol, alpha, beta) TYPE(dbcsr_type), INTENT(IN) :: matrix - TYPE(cp_fm_type), INTENT(IN) :: fm_in, fm_out + TYPE(cp_fm_type), INTENT(IN) :: fm_in + TYPE(cp_fm_type), INTENT(INOUT) :: fm_out INTEGER, INTENT(IN) :: ncol REAL(dp), INTENT(IN), OPTIONAL :: alpha, beta diff --git a/src/ct_methods.F b/src/ct_methods.F index 74d4bba0a6..51fa31b8cb 100644 --- a/src/ct_methods.F +++ b/src/ct_methods.F @@ -15,9 +15,10 @@ MODULE ct_methods USE cp_dbcsr_api, ONLY: & dbcsr_add, dbcsr_copy, dbcsr_create, dbcsr_desymmetrize, dbcsr_dot, dbcsr_filter, & dbcsr_finalize, dbcsr_get_diag, dbcsr_get_info, dbcsr_iterator_blocks_left, & - dbcsr_iterator_next_block, dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, & - dbcsr_multiply, dbcsr_put_block, dbcsr_release, dbcsr_scale, dbcsr_set, dbcsr_set_diag, & - dbcsr_transposed, dbcsr_type, dbcsr_type_no_symmetry, dbcsr_work_create + dbcsr_iterator_next_block, dbcsr_iterator_readonly_start, dbcsr_iterator_start, & + dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_multiply, dbcsr_put_block, dbcsr_release, & + dbcsr_scale, dbcsr_set, dbcsr_set_diag, dbcsr_transposed, dbcsr_type, & + dbcsr_type_no_symmetry, dbcsr_work_create USE cp_dbcsr_cholesky, ONLY: cp_dbcsr_cholesky_decompose,& cp_dbcsr_cholesky_invert USE cp_dbcsr_contrib, ONLY: dbcsr_add_on_diag,& @@ -1520,7 +1521,7 @@ CONTAINS IF (do_eigenvalues) & CALL dbcsr_work_create(e, work_mutable=.TRUE.) - CALL dbcsr_iterator_start(iter, matrix) + CALL dbcsr_iterator_readonly_start(iter, matrix) DO WHILE (dbcsr_iterator_blocks_left(iter)) diff --git a/src/dbx/cp_dbcsr_api.F b/src/dbx/cp_dbcsr_api.F index 297caaa639..5a37e05893 100644 --- a/src/dbx/cp_dbcsr_api.F +++ b/src/dbx/cp_dbcsr_api.F @@ -117,6 +117,7 @@ MODULE cp_dbcsr_api ! iterator PUBLIC :: dbcsr_iterator_start + PUBLIC :: dbcsr_iterator_readonly_start PUBLIC :: dbcsr_iterator_stop PUBLIC :: dbcsr_iterator_blocks_left PUBLIC :: dbcsr_iterator_next_block @@ -1065,22 +1066,41 @@ CONTAINS !> \param shared ... !> \param dynamic ... !> \param dynamic_byrows ... -!> \param read_only ... ! ************************************************************************************************** - SUBROUTINE dbcsr_iterator_start(iterator, matrix, shared, dynamic, dynamic_byrows, read_only) + SUBROUTINE dbcsr_iterator_start(iterator, matrix, shared, dynamic, dynamic_byrows) TYPE(dbcsr_iterator_type), INTENT(OUT) :: iterator - TYPE(dbcsr_type), INTENT(IN) :: matrix - LOGICAL, INTENT(IN), OPTIONAL :: shared, dynamic, dynamic_byrows, & - read_only + TYPE(dbcsr_type), INTENT(INOUT) :: matrix + LOGICAL, INTENT(IN), OPTIONAL :: shared, dynamic, dynamic_byrows IF (USE_DBCSR_BACKEND) THEN - CALL dbcsr_iterator_start_prv(iterator%dbcsr, matrix%dbcsr, shared, dynamic, & - dynamic_byrows, read_only) + CALL dbcsr_iterator_start_prv(iterator%dbcsr, matrix%dbcsr, shared, dynamic, dynamic_byrows) ELSE CPABORT("Not yet implemented for DBM.") END IF END SUBROUTINE dbcsr_iterator_start +! ************************************************************************************************** +!> \brief Like dbcsr_iterator_start() but with matrix being INTENT(IN). +!> When invoking this routine, the caller promises not to modify the returned blocks. +!> \param iterator ... +!> \param matrix ... +!> \param shared ... +!> \param dynamic ... +!> \param dynamic_byrows ... +! ************************************************************************************************** + SUBROUTINE dbcsr_iterator_readonly_start(iterator, matrix, shared, dynamic, dynamic_byrows) + TYPE(dbcsr_iterator_type), INTENT(OUT) :: iterator + TYPE(dbcsr_type), INTENT(IN) :: matrix + LOGICAL, INTENT(IN), OPTIONAL :: shared, dynamic, dynamic_byrows + + IF (USE_DBCSR_BACKEND) THEN + CALL dbcsr_iterator_start_prv(iterator%dbcsr, matrix%dbcsr, shared, dynamic, & + dynamic_byrows, read_only=.TRUE.) + ELSE + CPABORT("Not yet implemented for DBM.") + END IF + END SUBROUTINE dbcsr_iterator_readonly_start + ! ************************************************************************************************** !> \brief ... !> \param iterator ... diff --git a/src/dbx/cp_dbcsr_contrib.F b/src/dbx/cp_dbcsr_contrib.F index 2fed4fc0dc..25cceb3168 100644 --- a/src/dbx/cp_dbcsr_contrib.F +++ b/src/dbx/cp_dbcsr_contrib.F @@ -10,8 +10,8 @@ MODULE cp_dbcsr_contrib dbcsr_clear, dbcsr_distribution_get, dbcsr_distribution_type, dbcsr_finalize, & dbcsr_get_info, dbcsr_get_readonly_block_p, dbcsr_get_stored_coordinates, & dbcsr_has_symmetry, dbcsr_iterator_blocks_left, dbcsr_iterator_next_block, & - dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_put_block, & - dbcsr_reserve_blocks, dbcsr_type + dbcsr_iterator_readonly_start, dbcsr_iterator_start, dbcsr_iterator_stop, & + dbcsr_iterator_type, dbcsr_put_block, dbcsr_reserve_blocks, dbcsr_type USE dbm_tests, ONLY: generate_larnv_seed USE kinds, ONLY: dp USE message_passing, ONLY: mp_comm_type @@ -58,7 +58,7 @@ CONTAINS END IF CALL dbcsr_clear(matrix_c) - CALL dbcsr_iterator_start(iter, matrix_a) + CALL dbcsr_iterator_readonly_start(iter, matrix_a) DO WHILE (dbcsr_iterator_blocks_left(iter)) CALL dbcsr_iterator_next_block(iter, row, col, block_a) CALL dbcsr_get_readonly_block_p(matrix_b, row, col, block_b, found_b) @@ -90,7 +90,7 @@ CONTAINS CALL timeset(routineN, handle) norm = 0.0_dp - CALL dbcsr_iterator_start(iter, matrix) + CALL dbcsr_iterator_readonly_start(iter, matrix) DO WHILE (dbcsr_iterator_blocks_left(iter)) CALL dbcsr_iterator_next_block(iter, block=block) norm = MAX(norm, MAXVAL(ABS(block))) @@ -124,7 +124,7 @@ CONTAINS has_symmetry = dbcsr_has_symmetry(matrix) norm = 0.0_dp - CALL dbcsr_iterator_start(iter, matrix) + CALL dbcsr_iterator_readonly_start(iter, matrix) DO WHILE (dbcsr_iterator_blocks_left(iter)) CALL dbcsr_iterator_next_block(iter, row, col, block) IF (has_symmetry .AND. row /= col) THEN @@ -169,7 +169,7 @@ CONTAINS ALLOCATE (buffer(nrow)) buffer = 0.0_dp - CALL dbcsr_iterator_start(iter, matrix) + CALL dbcsr_iterator_readonly_start(iter, matrix) DO WHILE (dbcsr_iterator_blocks_left(iter)) CALL dbcsr_iterator_next_block(iter, row, col, block, row_offset=row_offset, col_offset=col_offset) DO j = 1, SIZE(block, 2) diff --git a/src/et_coupling_proj.F b/src/et_coupling_proj.F index cec13f1461..0cd377d676 100644 --- a/src/et_coupling_proj.F +++ b/src/et_coupling_proj.F @@ -453,7 +453,8 @@ CONTAINS ! Routine arguments TYPE(qs_environment_type), POINTER :: qs_env - TYPE(cp_fm_type), INTENT(IN) :: mat_t, mat_i, mat_w + TYPE(cp_fm_type), INTENT(INOUT) :: mat_t, mat_i + TYPE(cp_fm_type), INTENT(IN) :: mat_w INTEGER :: n_deps TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: mat_s diff --git a/src/mp2_cphf.F b/src/mp2_cphf.F index 6e5523e24e..0a027d3bb8 100644 --- a/src/mp2_cphf.F +++ b/src/mp2_cphf.F @@ -557,7 +557,8 @@ CONTAINS INTENT(IN) :: Eigenval TYPE(qs_p_env_type) :: p_env TYPE(cp_fm_type), DIMENSION(nspins), INTENT(IN) :: fm_mo - TYPE(cp_fm_type), INTENT(IN) :: fm_ao, fm_back + TYPE(cp_fm_type), INTENT(INOUT) :: fm_ao + TYPE(cp_fm_type), INTENT(IN) :: fm_back INTEGER, INTENT(IN) :: transf_type_in TYPE(cp_fm_type), DIMENSION(nspins), INTENT(IN) :: fm_mo_out LOGICAL, INTENT(IN), OPTIONAL :: recalc_hfx_integrals @@ -690,7 +691,8 @@ CONTAINS INTENT(IN) :: Eigenval TYPE(qs_p_env_type), INTENT(IN), POINTER :: p_env TYPE(cp_fm_type), DIMENSION(dimen), INTENT(IN) :: L_jb - TYPE(cp_fm_type), INTENT(IN) :: fm_G_mu_nu, fm_back + TYPE(cp_fm_type), INTENT(INOUT) :: fm_G_mu_nu + TYPE(cp_fm_type), INTENT(IN) :: fm_back TYPE(cp_fm_type), DIMENSION(nspins), INTENT(IN) :: P_ia CHARACTER(LEN=*), PARAMETER :: routineN = 'solve_z_vector_eq_low' @@ -782,7 +784,8 @@ CONTAINS INTENT(IN) :: Eigenval TYPE(qs_p_env_type), INTENT(IN), POINTER :: p_env TYPE(cp_fm_type), DIMENSION(nspins), INTENT(IN) :: L_jb - TYPE(cp_fm_type), INTENT(IN) :: fm_G_mu_nu, fm_back + TYPE(cp_fm_type), INTENT(INOUT) :: fm_G_mu_nu + TYPE(cp_fm_type), INTENT(IN) :: fm_back TYPE(cp_fm_type), DIMENSION(nspins), INTENT(IN) :: P_ia, precond CHARACTER(LEN=*), PARAMETER :: routineN = 'solve_z_vector_pople' @@ -1031,7 +1034,8 @@ CONTAINS INTENT(IN) :: Eigenval TYPE(qs_p_env_type), INTENT(IN), POINTER :: p_env TYPE(cp_fm_type), DIMENSION(nspins), INTENT(IN) :: L_jb - TYPE(cp_fm_type), INTENT(IN) :: fm_G_mu_nu, fm_back + TYPE(cp_fm_type), INTENT(INOUT) :: fm_G_mu_nu + TYPE(cp_fm_type), INTENT(IN) :: fm_back TYPE(cp_fm_type), DIMENSION(nspins), INTENT(IN) :: P_ia, precond CHARACTER(LEN=*), PARAMETER :: routineN = 'solve_z_vector_cg' diff --git a/src/mscfg_types.F b/src/mscfg_types.F index f9d7d0ddeb..40591bacf6 100644 --- a/src/mscfg_types.F +++ b/src/mscfg_types.F @@ -16,7 +16,7 @@ MODULE mscfg_types dbcsr_add, dbcsr_complete_redistribute, dbcsr_create, dbcsr_distribution_get, & dbcsr_distribution_new, dbcsr_distribution_release, dbcsr_distribution_type, & dbcsr_finalize, dbcsr_get_info, dbcsr_iterator_blocks_left, dbcsr_iterator_next_block, & - dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_put_block, & + dbcsr_iterator_readonly_start, dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_put_block, & dbcsr_release, dbcsr_set, dbcsr_type, dbcsr_type_no_symmetry, dbcsr_work_create USE kinds, ONLY: dp #include "./base/base_uses.f90" @@ -289,7 +289,7 @@ CONTAINS CALL dbcsr_work_create(matrix_new, work_mutable=.TRUE.) ! iterate over local blocks of the small matrix - CALL dbcsr_iterator_start(iter, submatrix_in) + CALL dbcsr_iterator_readonly_start(iter, submatrix_in) DO WHILE (dbcsr_iterator_blocks_left(iter)) diff --git a/src/optimize_embedding_potential.F b/src/optimize_embedding_potential.F index 37757b9290..488ff831a5 100644 --- a/src/optimize_embedding_potential.F +++ b/src/optimize_embedding_potential.F @@ -1317,7 +1317,7 @@ CONTAINS ! ************************************************************************************************** SUBROUTINE compute_kinetic_mat(qs_env, kinetic_mat) TYPE(qs_environment_type), POINTER :: qs_env - TYPE(cp_fm_type), INTENT(IN) :: kinetic_mat + TYPE(cp_fm_type), INTENT(INOUT) :: kinetic_mat CHARACTER(LEN=*), PARAMETER :: routineN = 'compute_kinetic_mat' diff --git a/src/qs_dcdr_utils.F b/src/qs_dcdr_utils.F index 87d4929b8e..beb5910c1e 100644 --- a/src/qs_dcdr_utils.F +++ b/src/qs_dcdr_utils.F @@ -111,7 +111,8 @@ CONTAINS ! ************************************************************************************************** SUBROUTINE multiply_localization(ao_matrix, mo_coeff, work, nmo, icenter, res) TYPE(dbcsr_type), INTENT(IN), POINTER :: ao_matrix - TYPE(cp_fm_type), INTENT(IN) :: mo_coeff, work + TYPE(cp_fm_type), INTENT(IN) :: mo_coeff + TYPE(cp_fm_type), INTENT(INOUT) :: work INTEGER, INTENT(IN) :: nmo, icenter TYPE(cp_fm_type), INTENT(IN) :: res diff --git a/src/qs_fb_env_methods.F b/src/qs_fb_env_methods.F index 9f6367bf7c..0256a730da 100644 --- a/src/qs_fb_env_methods.F +++ b/src/qs_fb_env_methods.F @@ -17,9 +17,9 @@ MODULE qs_fb_env_methods USE cp_control_types, ONLY: dft_control_type USE cp_dbcsr_api, ONLY: & dbcsr_create, dbcsr_finalize, dbcsr_get_info, dbcsr_iterator_blocks_left, & - dbcsr_iterator_next_block, dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, & - dbcsr_multiply, dbcsr_p_type, dbcsr_release, dbcsr_reserve_blocks, dbcsr_set, dbcsr_type, & - dbcsr_type_no_symmetry + dbcsr_iterator_next_block, dbcsr_iterator_readonly_start, dbcsr_iterator_stop, & + dbcsr_iterator_type, dbcsr_multiply, dbcsr_p_type, dbcsr_release, dbcsr_reserve_blocks, & + dbcsr_set, dbcsr_type, dbcsr_type_no_symmetry USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm,& dbcsr_allocate_matrix_set,& dbcsr_deallocate_matrix_set @@ -1125,7 +1125,6 @@ CONTAINS INTEGER :: iatom, jatom, nblkcols_total, & nblkrows_total, nblks INTEGER, ALLOCATABLE, DIMENSION(:) :: cols, rows - REAL(dp), DIMENSION(:, :), POINTER :: mat_block TYPE(dbcsr_iterator_type) :: iter CALL dbcsr_get_info(matrix=matrix_in, & @@ -1138,9 +1137,9 @@ CONTAINS rows(:) = 0 cols(:) = 0 nblks = 0 - CALL dbcsr_iterator_start(iter, matrix_in) + CALL dbcsr_iterator_readonly_start(iter, matrix_in) DO WHILE (dbcsr_iterator_blocks_left(iter)) - CALL dbcsr_iterator_next_block(iter, iatom, jatom, mat_block) + CALL dbcsr_iterator_next_block(iter, iatom, jatom) nblks = nblks + 1 rows(nblks) = iatom cols(nblks) = jatom diff --git a/src/qs_linres_kernel.F b/src/qs_linres_kernel.F index da2d1111b2..86e3e9bd21 100644 --- a/src/qs_linres_kernel.F +++ b/src/qs_linres_kernel.F @@ -133,7 +133,8 @@ CONTAINS ! TYPE(qs_environment_type), POINTER :: qs_env TYPE(qs_p_env_type) :: p_env - TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: c0, Av + TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: c0 + TYPE(cp_fm_type), DIMENSION(:), INTENT(INOUT) :: Av INTEGER :: ispin, ncol TYPE(dft_control_type), POINTER :: dft_control diff --git a/src/qs_linres_methods.F b/src/qs_linres_methods.F index 4ba3bc74b4..790bacb04b 100644 --- a/src/qs_linres_methods.F +++ b/src/qs_linres_methods.F @@ -567,7 +567,9 @@ CONTAINS ! TYPE(qs_environment_type), INTENT(IN), POINTER :: qs_env TYPE(qs_p_env_type) :: p_env - TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: c0, v, Av, chc + TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: c0, v + TYPE(cp_fm_type), DIMENSION(:), INTENT(INOUT) :: Av + TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: chc CHARACTER(LEN=*), PARAMETER :: routineN = 'apply_op' @@ -662,7 +664,8 @@ CONTAINS ! ************************************************************************************************** SUBROUTINE apply_op_1(v, Av, matrix_ks, matrix_s, chc) ! - TYPE(cp_fm_type), INTENT(IN) :: v, Av + TYPE(cp_fm_type), INTENT(IN) :: v + TYPE(cp_fm_type), INTENT(INOUT) :: Av TYPE(dbcsr_type), INTENT(IN) :: matrix_ks, matrix_s TYPE(cp_fm_type), INTENT(IN) :: chc diff --git a/src/qs_moments.F b/src/qs_moments.F index d93242e850..6128f469c3 100644 --- a/src/qs_moments.F +++ b/src/qs_moments.F @@ -2110,7 +2110,7 @@ CONTAINS TYPE(dbcsr_type), POINTER :: cosmat, sinmat TYPE(mo_set_type), DIMENSION(:), INTENT(IN) :: mos TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: op_fm_set - TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: opvec + TYPE(cp_fm_type), DIMENSION(:), INTENT(INOUT) :: opvec INTEGER :: i, nao, nmo TYPE(cp_fm_type), POINTER :: mo_coeff diff --git a/src/qs_ot_eigensolver.F b/src/qs_ot_eigensolver.F index 063f3bbaec..ac267f8522 100644 --- a/src/qs_ot_eigensolver.F +++ b/src/qs_ot_eigensolver.F @@ -73,7 +73,7 @@ CONTAINS TYPE(dbcsr_type), POINTER :: matrix_h, matrix_s TYPE(cp_fm_type), INTENT(IN), OPTIONAL :: matrix_orthogonal_space_fm - TYPE(cp_fm_type), INTENT(IN) :: matrix_c_fm + TYPE(cp_fm_type), INTENT(INOUT) :: matrix_c_fm TYPE(preconditioner_type), OPTIONAL, POINTER :: preconditioner REAL(KIND=dp) :: eps_gradient INTEGER, INTENT(IN) :: iter_max diff --git a/src/qs_p_env_methods.F b/src/qs_p_env_methods.F index 62ba899adf..2d8464dd9b 100644 --- a/src/qs_p_env_methods.F +++ b/src/qs_p_env_methods.F @@ -718,7 +718,8 @@ CONTAINS TYPE(qs_p_env_type) :: p_env TYPE(qs_environment_type), POINTER :: qs_env INTEGER, INTENT(IN) :: spin - TYPE(cp_fm_type), INTENT(IN) :: v, res + TYPE(cp_fm_type), INTENT(IN) :: v + TYPE(cp_fm_type), INTENT(INOUT) :: res CHARACTER(len=*), PARAMETER :: routineN = 'p_op_l1_spin' diff --git a/src/qs_scf_methods.F b/src/qs_scf_methods.F index df187ef62b..41337d4bdc 100644 --- a/src/qs_scf_methods.F +++ b/src/qs_scf_methods.F @@ -262,10 +262,11 @@ CONTAINS !> \param ksbuf2 ... ! ************************************************************************************************** SUBROUTINE eigensolver_dbcsr(matrix_ks, matrix_ks_fm, mo_set, ortho_dbcsr, ksbuf1, ksbuf2) - TYPE(dbcsr_type), POINTER :: matrix_ks - TYPE(cp_fm_type), INTENT(IN) :: matrix_ks_fm + TYPE(dbcsr_type), INTENT(IN) :: matrix_ks + TYPE(cp_fm_type), INTENT(INOUT) :: matrix_ks_fm TYPE(mo_set_type), INTENT(IN) :: mo_set - TYPE(dbcsr_type), POINTER :: ortho_dbcsr, ksbuf1, ksbuf2 + TYPE(dbcsr_type), INTENT(IN) :: ortho_dbcsr + TYPE(dbcsr_type), INTENT(INOUT) :: ksbuf1, ksbuf2 CHARACTER(len=*), PARAMETER :: routineN = 'eigensolver_dbcsr' diff --git a/src/qs_tddfpt2_densities.F b/src/qs_tddfpt2_densities.F index a9d431a8e5..fdf765e465 100644 --- a/src/qs_tddfpt2_densities.F +++ b/src/qs_tddfpt2_densities.F @@ -162,7 +162,8 @@ CONTAINS TYPE(local_rho_type), POINTER :: local_rho_set TYPE(qs_environment_type), POINTER :: qs_env TYPE(tddfpt_subgroup_env_type), INTENT(in) :: sub_env - TYPE(cp_fm_type), INTENT(IN) :: wfm_rho_orb, wfm_rho_aux_fit, wfm_aux_orb + TYPE(cp_fm_type), INTENT(INOUT) :: wfm_rho_orb + TYPE(cp_fm_type), INTENT(IN) :: wfm_rho_aux_fit, wfm_aux_orb CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_construct_aux_fit_density' diff --git a/src/qs_tddfpt2_eigensolver.F b/src/qs_tddfpt2_eigensolver.F index cf8505fe5c..b5cf6fba91 100644 --- a/src/qs_tddfpt2_eigensolver.F +++ b/src/qs_tddfpt2_eigensolver.F @@ -262,7 +262,7 @@ CONTAINS SUBROUTINE tddfpt_orthonormalize_psi1_psi1(evects, nvects_new, S_evects, matrix_s) TYPE(cp_fm_type), DIMENSION(:, :), INTENT(in) :: evects INTEGER, INTENT(in) :: nvects_new - TYPE(cp_fm_type), DIMENSION(:, :), INTENT(in) :: S_evects + TYPE(cp_fm_type), DIMENSION(:, :), INTENT(INOUT) :: S_evects TYPE(dbcsr_type), POINTER :: matrix_s CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_orthonormalize_psi1_psi1' @@ -342,7 +342,8 @@ CONTAINS SUBROUTINE tddfpt_compute_Aop_evects(Aop_evects, evects, S_evects, gs_mos, tddfpt_control, & matrix_ks, qs_env, kernel_env, & sub_env, work_matrices, matrix_s) - TYPE(cp_fm_type), DIMENSION(:, :), INTENT(in) :: Aop_evects, evects, S_evects + TYPE(cp_fm_type), DIMENSION(:, :), INTENT(INOUT) :: Aop_evects + TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: evects, S_evects TYPE(tddfpt_ground_state_mos), DIMENSION(:), & INTENT(in) :: gs_mos TYPE(tddfpt2_control_type), POINTER :: tddfpt_control diff --git a/src/qs_tddfpt2_fhxc.F b/src/qs_tddfpt2_fhxc.F index 19d96827b4..bf74858562 100644 --- a/src/qs_tddfpt2_fhxc.F +++ b/src/qs_tddfpt2_fhxc.F @@ -97,7 +97,8 @@ CONTAINS do_hfx, do_admm, qs_env, kernel_env, kernel_env_admm_aux, & sub_env, work_matrices, admm_symm, admm_xc_correction, do_lrigpw, & tddfpt_mgrid) - TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: Aop_evects, evects + TYPE(cp_fm_type), DIMENSION(:, :), INTENT(INOUT) :: Aop_evects + TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: evects LOGICAL, INTENT(in) :: is_rks_triplets, do_hfx, do_admm TYPE(qs_environment_type), POINTER :: qs_env TYPE(full_kernel_env_type), POINTER :: kernel_env, kernel_env_admm_aux @@ -495,7 +496,8 @@ CONTAINS qs_env, stda_control, stda_env, & sub_env, work_matrices) - TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: Aop_evects, evects + TYPE(cp_fm_type), DIMENSION(:, :), INTENT(INOUT) :: Aop_evects + TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: evects LOGICAL, INTENT(in) :: is_rks_triplets TYPE(qs_environment_type), POINTER :: qs_env TYPE(stda_control_type) :: stda_control diff --git a/src/qs_tddfpt2_forces.F b/src/qs_tddfpt2_forces.F index f8033dbca6..50a1a66995 100644 --- a/src/qs_tddfpt2_forces.F +++ b/src/qs_tddfpt2_forces.F @@ -648,7 +648,7 @@ CONTAINS TYPE(tddfpt_ground_state_mos), DIMENSION(:), & POINTER :: gs_mos TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_hz - TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: cpmos + TYPE(cp_fm_type), DIMENSION(:), INTENT(INOUT) :: cpmos CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_resvec2' @@ -1142,7 +1142,7 @@ CONTAINS TYPE(tddfpt_ground_state_mos), DIMENSION(:), & POINTER :: gs_mos TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_hz - TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: cpmos + TYPE(cp_fm_type), DIMENSION(:), INTENT(INOUT) :: cpmos CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_resvec2_xtb' diff --git a/src/qs_tddfpt2_operators.F b/src/qs_tddfpt2_operators.F index 39d13f2438..efc46a6c7a 100644 --- a/src/qs_tddfpt2_operators.F +++ b/src/qs_tddfpt2_operators.F @@ -102,7 +102,8 @@ CONTAINS !> Thomas Chassaing on 08.2002. ! ************************************************************************************************** SUBROUTINE tddfpt_apply_energy_diff(Aop_evects, evects, S_evects, gs_mos, matrix_ks) - TYPE(cp_fm_type), DIMENSION(:, :), INTENT(in) :: Aop_evects, evects, S_evects + TYPE(cp_fm_type), DIMENSION(:, :), INTENT(INOUT) :: Aop_evects + TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: evects, S_evects TYPE(tddfpt_ground_state_mos), DIMENSION(:), & INTENT(in) :: gs_mos TYPE(dbcsr_p_type), DIMENSION(:), INTENT(in) :: matrix_ks @@ -515,7 +516,8 @@ CONTAINS SUBROUTINE tddfpt_apply_hfx(Aop_evects, evects, gs_mos, do_admm, qs_env, & work_rho_ia_ao_symm, work_hmat_symm, work_rho_ia_ao_asymm, & work_hmat_asymm, wfm_rho_orb) - TYPE(cp_fm_type), DIMENSION(:, :), INTENT(in) :: Aop_evects, evects + TYPE(cp_fm_type), DIMENSION(:, :), INTENT(INOUT) :: Aop_evects + TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: evects TYPE(tddfpt_ground_state_mos), DIMENSION(:), & INTENT(in) :: gs_mos LOGICAL, INTENT(in) :: do_admm @@ -768,7 +770,8 @@ CONTAINS TYPE(tddfpt_subgroup_env_type) :: sub_env REAL(KIND=dp), INTENT(IN) :: rcut, hfx_scale TYPE(tddfpt_work_matrices) :: work - TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: X, res + TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: X + TYPE(cp_fm_type), DIMENSION(:), INTENT(INOUT) :: res CHARACTER(len=*), PARAMETER :: routineN = 'tddfpt_apply_hfxlr_kernel' diff --git a/src/qs_tddfpt2_restart.F b/src/qs_tddfpt2_restart.F index ccd54ec75b..802014f4ef 100644 --- a/src/qs_tddfpt2_restart.F +++ b/src/qs_tddfpt2_restart.F @@ -320,7 +320,7 @@ CONTAINS TYPE(cp_logger_type), INTENT(in), POINTER :: logger TYPE(section_vals_type), INTENT(in), POINTER :: tddfpt_print_section TYPE(dbcsr_type), INTENT(in), POINTER :: matrix_s - TYPE(cp_fm_type), DIMENSION(:, :), INTENT(in) :: S_evects + TYPE(cp_fm_type), DIMENSION(:, :), INTENT(INOUT) :: S_evects TYPE(tddfpt_subgroup_env_type), INTENT(in) :: sub_env CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_write_newtonx_output' @@ -512,7 +512,7 @@ CONTAINS TYPE(cp_fm_type), DIMENSION(:, :), INTENT(in) :: evects INTEGER, INTENT(in) :: ounit - TYPE(cp_fm_type), DIMENSION(:, :), INTENT(in) :: S_evects + TYPE(cp_fm_type), DIMENSION(:, :), INTENT(INOUT) :: S_evects TYPE(dbcsr_type), INTENT(in), POINTER :: matrix_s CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_check_orthonormality' diff --git a/src/qs_tddfpt2_stda_utils.F b/src/qs_tddfpt2_stda_utils.F index 5c3d58eac7..bd007a12d0 100644 --- a/src/qs_tddfpt2_stda_utils.F +++ b/src/qs_tddfpt2_stda_utils.F @@ -468,8 +468,9 @@ CONTAINS ! ************************************************************************************************** SUBROUTINE get_lowdin_x(shalf, xvec, xt) - TYPE(dbcsr_type) :: shalf - TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: xvec, xt + TYPE(dbcsr_type), INTENT(IN) :: shalf + TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: xvec + TYPE(cp_fm_type), DIMENSION(:), INTENT(INOUT) :: xt CHARACTER(len=*), PARAMETER :: routineN = 'get_lowdin_x' @@ -512,7 +513,8 @@ CONTAINS TYPE(tddfpt_subgroup_env_type) :: sub_env TYPE(tddfpt_work_matrices) :: work LOGICAL, INTENT(IN) :: is_rks_triplets - TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: X, res + TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: X + TYPE(cp_fm_type), DIMENSION(:), INTENT(INOUT) :: res CHARACTER(len=*), PARAMETER :: routineN = 'stda_calculate_kernel' diff --git a/src/qs_tddfpt_utils.F b/src/qs_tddfpt_utils.F index c52daa8b5a..37d5da6c5b 100644 --- a/src/qs_tddfpt_utils.F +++ b/src/qs_tddfpt_utils.F @@ -367,7 +367,8 @@ CONTAINS ! ************************************************************************************************** SUBROUTINE normalize(X, tmp_vec, metric) - TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: x, tmp_vec + TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: x + TYPE(cp_fm_type), DIMENSION(:), INTENT(INOUT) :: tmp_vec TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: metric INTEGER :: n_spins, spin diff --git a/src/rpa_gw_im_time_util.F b/src/rpa_gw_im_time_util.F index b63382dbb7..04507ead07 100644 --- a/src/rpa_gw_im_time_util.F +++ b/src/rpa_gw_im_time_util.F @@ -20,9 +20,9 @@ MODULE rpa_gw_im_time_util dbcsr_create, dbcsr_distribution_get, dbcsr_distribution_new, dbcsr_distribution_release, & dbcsr_distribution_type, dbcsr_filter, dbcsr_get_diag, dbcsr_get_info, & dbcsr_get_stored_coordinates, dbcsr_init_p, dbcsr_iterator_blocks_left, & - dbcsr_iterator_next_block, dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, & - dbcsr_multiply, dbcsr_p_type, dbcsr_release, dbcsr_release_p, dbcsr_set_diag, dbcsr_type, & - dbcsr_type_no_symmetry + dbcsr_iterator_next_block, dbcsr_iterator_readonly_start, dbcsr_iterator_start, & + dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_multiply, dbcsr_p_type, dbcsr_release, & + dbcsr_release_p, dbcsr_set_diag, dbcsr_type, dbcsr_type_no_symmetry USE cp_dbcsr_contrib, ONLY: dbcsr_add_on_diag,& dbcsr_reserve_all_blocks USE cp_dbcsr_operations, ONLY: copy_fm_to_dbcsr,& @@ -582,11 +582,10 @@ CONTAINS num_entries_send = 0 num_blocks_send = 0 - CALL dbcsr_iterator_start(iter, mat_orig) + CALL dbcsr_iterator_readonly_start(iter, mat_orig) DO WHILE (dbcsr_iterator_blocks_left(iter)) - CALL dbcsr_iterator_next_block(iter, row, col, data_block, & - row_size=row_size, col_size=col_size) + CALL dbcsr_iterator_next_block(iter, row, col, row_size=row_size, col_size=col_size) row_reflected = image_atom(row) @@ -650,7 +649,7 @@ CONTAINS ALLOCATE (entry_counter(0:para_env%num_pe - 1)) entry_counter(:) = 0 - CALL dbcsr_iterator_start(iter, mat_orig) + CALL dbcsr_iterator_readonly_start(iter, mat_orig) DO WHILE (dbcsr_iterator_blocks_left(iter)) CALL dbcsr_iterator_next_block(iter, row, col, data_block, & diff --git a/src/rpa_gw_kpoints_util.F b/src/rpa_gw_kpoints_util.F index 6530cd0181..4b7a4f8a1b 100644 --- a/src/rpa_gw_kpoints_util.F +++ b/src/rpa_gw_kpoints_util.F @@ -414,7 +414,7 @@ CONTAINS fm_mat_work, cfm_mat_Q, ikp, nkp, ikp_local, para_env) TYPE(dbcsr_p_type), DIMENSION(:, :), INTENT(INOUT) :: mat_P_omega_kp - TYPE(cp_fm_type), INTENT(IN) :: fm_mat_RI_global_work, fm_mat_work + TYPE(cp_fm_type), INTENT(INOUT) :: fm_mat_RI_global_work, fm_mat_work TYPE(cp_cfm_type), INTENT(IN) :: cfm_mat_Q INTEGER, INTENT(IN) :: ikp, nkp, ikp_local TYPE(mp_para_env_type), POINTER :: para_env diff --git a/src/rpa_rse.F b/src/rpa_rse.F index 3b1ec5b99f..cd5311df65 100644 --- a/src/rpa_rse.F +++ b/src/rpa_rse.F @@ -315,7 +315,7 @@ CONTAINS TYPE(dbcsr_p_type), DIMENSION(:), INTENT(IN), & POINTER :: mat_mu_nu TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: fm_P_mu_nu - TYPE(cp_fm_type), INTENT(IN) :: fm_X_ao + TYPE(cp_fm_type), INTENT(INOUT) :: fm_X_ao TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: fm_X_mo TYPE(cp_fm_type), INTENT(IN) :: fm_X_ao_mo @@ -412,7 +412,8 @@ CONTAINS ! ************************************************************************************************** SUBROUTINE xc_contribution(qs_env, fm_XC_ao, fm_XC_ao_mo, fm_XC_mo, mo_coeff, dimen) TYPE(qs_environment_type), INTENT(IN), POINTER :: qs_env - TYPE(cp_fm_type), INTENT(IN) :: fm_XC_ao, fm_XC_ao_mo + TYPE(cp_fm_type), INTENT(INOUT) :: fm_XC_ao + TYPE(cp_fm_type), INTENT(IN) :: fm_XC_ao_mo TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: fm_XC_mo, mo_coeff INTEGER, INTENT(IN) :: dimen diff --git a/src/rpa_util.F b/src/rpa_util.F index 833f83e269..0e9ca18b0f 100644 --- a/src/rpa_util.F +++ b/src/rpa_util.F @@ -1264,9 +1264,10 @@ CONTAINS SUBROUTINE contract_P_omega_with_mat_L(mat_P_omega, mat_L, mat_work, eps_filter_im_time, fm_mat_work, dimen_RI, & dimen_RI_red, fm_mat_L, fm_mat_Q) - TYPE(dbcsr_type), POINTER :: mat_P_omega, mat_L, mat_work + TYPE(dbcsr_type), INTENT(IN) :: mat_P_omega, mat_L + TYPE(dbcsr_type), INTENT(INOUT) :: mat_work REAL(KIND=dp), INTENT(IN) :: eps_filter_im_time - TYPE(cp_fm_type), INTENT(IN) :: fm_mat_work + TYPE(cp_fm_type), INTENT(INOUT) :: fm_mat_work INTEGER, INTENT(IN) :: dimen_RI, dimen_RI_red TYPE(cp_fm_type), INTENT(IN) :: fm_mat_L, fm_mat_Q diff --git a/src/submatrix_dissection.F b/src/submatrix_dissection.F index b60d4c8a27..83ad93fb2e 100644 --- a/src/submatrix_dissection.F +++ b/src/submatrix_dissection.F @@ -44,8 +44,8 @@ MODULE submatrix_dissection USE cp_dbcsr_api, ONLY: & dbcsr_distribution_get, dbcsr_distribution_type, dbcsr_finalize, dbcsr_get_block_p, & dbcsr_get_info, dbcsr_get_stored_coordinates, dbcsr_iterator_blocks_left, & - dbcsr_iterator_next_block, dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, & - dbcsr_put_block, dbcsr_type + dbcsr_iterator_next_block, dbcsr_iterator_readonly_start, dbcsr_iterator_stop, & + dbcsr_iterator_type, dbcsr_put_block, dbcsr_type USE kinds, ONLY: dp USE message_passing, ONLY: mp_comm_type USE submatrix_types, ONLY: buffer_type,& @@ -199,7 +199,7 @@ CONTAINS ! Determine number of locally stored blocks this%local_blocks = 0 - CALL dbcsr_iterator_start(iter, this%dbcsr_mat, read_only=.TRUE.) + CALL dbcsr_iterator_readonly_start(iter, this%dbcsr_mat) DO WHILE (dbcsr_iterator_blocks_left(iter)) CALL dbcsr_iterator_next_block(iter, cur_row, cur_col) this%local_blocks = this%local_blocks + 1 @@ -214,7 +214,7 @@ CONTAINS this%result_blocks_for_rank_buf_offsets(0:this%numnodes - 1)) i = 1 - CALL dbcsr_iterator_start(iter, this%dbcsr_mat, read_only=.TRUE.) + CALL dbcsr_iterator_readonly_start(iter, this%dbcsr_mat) DO WHILE (dbcsr_iterator_blocks_left(iter)) CALL dbcsr_iterator_next_block(iter, cur_row, cur_col) this%coo_cols_local(i) = cur_col diff --git a/src/xas_tdp_atom.F b/src/xas_tdp_atom.F index c72f63a7c9..8970b5ad80 100644 --- a/src/xas_tdp_atom.F +++ b/src/xas_tdp_atom.F @@ -31,9 +31,10 @@ MODULE xas_tdp_atom dbcsr_copy, dbcsr_create, dbcsr_distribution_get, dbcsr_distribution_new, & dbcsr_distribution_release, dbcsr_distribution_type, dbcsr_filter, dbcsr_finalize, & dbcsr_get_block_p, dbcsr_get_stored_coordinates, dbcsr_iterator_blocks_left, & - dbcsr_iterator_next_block, dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, & - dbcsr_p_type, dbcsr_put_block, dbcsr_release, dbcsr_replicate_all, dbcsr_set, dbcsr_type, & - dbcsr_type_antisymmetric, dbcsr_type_no_symmetry, dbcsr_type_symmetric + dbcsr_iterator_next_block, dbcsr_iterator_readonly_start, dbcsr_iterator_start, & + dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_p_type, dbcsr_put_block, dbcsr_release, & + dbcsr_replicate_all, dbcsr_set, dbcsr_type, dbcsr_type_antisymmetric, & + dbcsr_type_no_symmetry, dbcsr_type_symmetric USE cp_dbcsr_cholesky, ONLY: cp_dbcsr_cholesky_decompose,& cp_dbcsr_cholesky_invert USE cp_dbcsr_operations, ONLY: dbcsr_deallocate_matrix_set @@ -554,7 +555,7 @@ CONTAINS ALLOCATE (n_neighbors(nbase, 0:para_env%num_pe - 1)) n_neighbors = 0 - CALL dbcsr_iterator_start(iter, mat_s) + CALL dbcsr_iterator_readonly_start(iter, mat_s) DO WHILE (dbcsr_iterator_blocks_left(iter)) CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk) @@ -589,7 +590,7 @@ CONTAINS END DO ! Loop a second time over S, this time fill the neighbors details - CALL dbcsr_iterator_start(iter, mat_s) + CALL dbcsr_iterator_readonly_start(iter, mat_s) ALLOCATE (inb(nbase)) inb = 1 DO WHILE (dbcsr_iterator_blocks_left(iter)) diff --git a/src/xas_tdp_utils.F b/src/xas_tdp_utils.F index ea4f150853..4e90b9aa96 100644 --- a/src/xas_tdp_utils.F +++ b/src/xas_tdp_utils.F @@ -737,7 +737,7 @@ CONTAINS xas_tdp_control, qs_env) TYPE(dbcsr_type), POINTER :: matrix_tdp, metric - TYPE(cp_fm_type), INTENT(IN) :: evecs + TYPE(cp_fm_type), INTENT(INOUT) :: evecs REAL(dp), DIMENSION(:) :: evals INTEGER, INTENT(IN) :: neig LOGICAL :: do_sf