comp-chem/cp2k
1
0
Fork 0
mirror of https://github.com/cp2k/cp2k.git synced 2026-07-29 06:35:28 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions

DBX: Remove dbcsr_iterator_next_block_index

Browse source
This commit is contained in:
Ole Schütt 2025-02-14 23:07:22 +01:00 • committed by Ole Schütt
parent 8840d978b2
commit 43b953a4bc
9 changed files with 49 additions and 69 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/dbt/dbt_block.F
View file

@ -300,7 +300,7 @@ CONTAINS
TYPE(dbt_type), INTENT(INOUT) :: tensor_out
TYPE(dbcsr_type), POINTER :: matrix_in_desym
INTEGER :: blk, iblk, nblk, nblk_per_thread, a, b
INTEGER :: iblk, nblk, nblk_per_thread, a, b
INTEGER, ALLOCATABLE, DIMENSION(:) :: blk_ind_1, blk_ind_2
INTEGER, DIMENSION(2) :: ind_2d
TYPE(dbcsr_iterator_type) :: iter
@ -320,7 +320,7 @@ CONTAINS
ALLOCATE (blk_ind_1(nblk), blk_ind_2(nblk))
CALL dbcsr_iterator_start(iter, matrix_in_desym)
DO iblk = 1, nblk
CALL dbcsr_iterator_next_block(iter, ind_2d(1), ind_2d(2), blk)
CALL dbcsr_iterator_next_block(iter, ind_2d(1), ind_2d(2))
blk_ind_1(iblk) = ind_2d(1); blk_ind_2(iblk) = ind_2d(2)
END DO
CALL dbcsr_iterator_stop(iter)

27
src/dbx/cp_dbcsr_api.F
View file

@ -235,11 +235,6 @@ MODULE cp_dbcsr_api
MODULE PROCEDURE dbcsr_create_new, dbcsr_create_template
END INTERFACE
INTERFACE dbcsr_iterator_next_block
MODULE PROCEDURE dbcsr_iterator_next_block_index
MODULE PROCEDURE dbcsr_iterator_next_2d_block
END INTERFACE
CONTAINS
! **************************************************************************************************
@ -989,20 +984,6 @@ CONTAINS
blocks_left = dbcsr_iterator_blocks_left_prv(iterator%prv)
END FUNCTION dbcsr_iterator_blocks_left
! **************************************************************************************************
!> \brief ...
!> \param iterator ...
!> \param row ...
!> \param column ...
!> \param blk ...
! **************************************************************************************************
SUBROUTINE dbcsr_iterator_next_block_index(iterator, row, column, blk)
TYPE(dbcsr_iterator_type), INTENT(INOUT) :: iterator
INTEGER, INTENT(OUT) :: row, column, blk
CALL dbcsr_iterator_next_block_prv(iterator%prv, row=row, column=column, blk=blk)
END SUBROUTINE dbcsr_iterator_next_block_index
! **************************************************************************************************
!> \brief ...
!> \param iterator ...
@ -1015,9 +996,9 @@ CONTAINS
!> \param row_offset ...
!> \param col_offset ...
! **************************************************************************************************
SUBROUTINE dbcsr_iterator_next_2d_block(iterator, row, column, block, &
block_number, row_size, col_size, &
row_offset, col_offset)
SUBROUTINE dbcsr_iterator_next_block(iterator, row, column, block, &
block_number, row_size, col_size, &
row_offset, col_offset)
TYPE(dbcsr_iterator_type), INTENT(INOUT) :: iterator
INTEGER, INTENT(OUT), OPTIONAL :: row, column
REAL(kind=dp), DIMENSION(:, :), OPTIONAL, POINTER :: block
@ -1032,7 +1013,7 @@ CONTAINS
IF (PRESENT(block)) block => my_block
IF (PRESENT(row)) row = my_row
IF (PRESENT(column)) column = my_column
END SUBROUTINE dbcsr_iterator_next_2d_block
END SUBROUTINE dbcsr_iterator_next_block
! **************************************************************************************************
!> \brief ...

6
src/hfx_ri_kp.F
View file

@ -2004,8 +2004,8 @@ CONTAINS
CHARACTER(LEN=*), PARAMETER :: routineN = 'get_ext_2c_int'
INTEGER :: blk, group, handle, handle2, i_img, i_RI, iatom, iblk, ikind, img_tot, j_img, &
j_RI, jatom, jblk, jkind, n_dependent, natom, nblks_RI, nimg, nkind
INTEGER :: group, handle, handle2, i_img, i_RI, iatom, iblk, ikind, img_tot, j_img, j_RI, &
jatom, jblk, jkind, n_dependent, natom, nblks_RI, nimg, nkind
INTEGER, ALLOCATABLE, DIMENSION(:) :: dist1, dist2
INTEGER, ALLOCATABLE, DIMENSION(:, :) :: present_atoms_i, present_atoms_j
INTEGER, DIMENSION(3) :: cell_b, cell_i, cell_j, cell_tot
@ -2158,7 +2158,7 @@ CONTAINS
CALL dbcsr_iterator_start(dbcsr_iter, mat_orig(img_tot))
DO WHILE (dbcsr_iterator_blocks_left(dbcsr_iter))
CALL dbcsr_iterator_next_block(dbcsr_iter, row=iatom, column=jatom, blk=blk)
CALL dbcsr_iterator_next_block(dbcsr_iter, row=iatom, column=jatom)
IF (present_atoms_i(iatom, i_img) == 0) CYCLE
IF (present_atoms_j(jatom, j_img) == 0) CYCLE
IF (my_offd .AND. (i_RI - 1)*natom + iatom == (j_RI - 1)*natom + jatom) CYCLE

4
src/qs_ot.F
View file

@ -869,7 +869,7 @@ CONTAINS
TYPE(dbcsr_iterator_type) :: iter
INTEGER, DIMENSION(:), POINTER :: row_blk_offset, col_blk_offset
REAL(dp), DIMENSION(:, :), POINTER :: block_in_re, block_in_im, block_out_re, block_out_im
INTEGER :: row, col, blk
INTEGER :: row, col
LOGICAL :: found
COMPLEX(dp) :: cval_in, cval_out
TYPE(dbcsr_distribution_type) :: dist
@ -901,7 +901,7 @@ CONTAINS
CALL dbcsr_get_info(qs_ot_env%rot_mat_dedu, row_blk_offset=row_blk_offset, col_blk_offset=col_blk_offset)
CALL dbcsr_iterator_start(iter, qs_ot_env%rot_mat_dedu)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row, col, blk)
CALL dbcsr_iterator_next_block(iter, row, col)
CALL dbcsr_get_block_p(inner_deriv_re, row, col, block_in_re, found)
CALL dbcsr_get_block_p(inner_deriv_im, row, col, block_in_im, found)
CALL dbcsr_get_block_p(outer_deriv_re, row, col, block_out_re, found)

6
src/rpa_im_time_force_methods.F
View file

@ -2994,8 +2994,8 @@ CONTAINS
CHARACTER(len=*), PARAMETER :: routineN = 'get_2c_mme_forces'
INTEGER :: atom_a, atom_b, blk, G_count, handle, i_xyz, iatom, ikind, iset, jatom, jkind, &
jset, natom, nkind, nseta, nsetb, offset_hab_a, offset_hab_b, R_count, sgfa, sgfb
INTEGER :: atom_a, atom_b, G_count, handle, i_xyz, iatom, ikind, iset, jatom, jkind, jset, &
natom, nkind, nseta, nsetb, offset_hab_a, offset_hab_b, R_count, sgfa, sgfb
INTEGER, ALLOCATABLE, DIMENSION(:) :: atom_of_kind, kind_of
INTEGER, DIMENSION(:), POINTER :: la_max, la_min, lb_max, lb_min, npgfa, &
npgfb, nsgfa, nsgfb
@ -3037,7 +3037,7 @@ CONTAINS
CALL dbcsr_iterator_start(iter, G_PQ)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row=iatom, column=jatom, blk=blk)
CALL dbcsr_iterator_next_block(iter, row=iatom, column=jatom)
CALL dbcsr_get_block_p(G_PQ, iatom, jatom, pblock, found)
IF (.NOT. found) CYCLE
IF (iatom > jatom) CYCLE

6
src/submatrix_dissection.F
View file

@ -144,7 +144,7 @@ CONTAINS
CLASS(submatrix_dissection_type), INTENT(INOUT) :: this
TYPE(dbcsr_type), INTENT(IN) :: matrix_p
INTEGER :: cur_row, cur_col, cur_blk, i, j, k, l, m, l_limit_left, l_limit_right, &
INTEGER :: cur_row, cur_col, i, j, k, l, m, l_limit_left, l_limit_right, &
bufsize, bufsize_next
INTEGER, DIMENSION(:), ALLOCATABLE :: blocks_per_rank, coo_dsplcmnts, num_blockids_send, num_blockids_recv
TYPE(dbcsr_iterator_type) :: iter
@ -203,7 +203,7 @@ CONTAINS
this%local_blocks = 0
CALL dbcsr_iterator_start(iter, this%dbcsr_mat, read_only=.TRUE.)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, cur_row, cur_col, cur_blk)
CALL dbcsr_iterator_next_block(iter, cur_row, cur_col)
this%local_blocks = this%local_blocks + 1
END DO
CALL dbcsr_iterator_stop(iter)
@ -218,7 +218,7 @@ CONTAINS
i = 1
CALL dbcsr_iterator_start(iter, this%dbcsr_mat, read_only=.TRUE.)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, cur_row, cur_col, cur_blk)
CALL dbcsr_iterator_next_block(iter, cur_row, cur_col)
this%coo_cols_local(i) = cur_col
this%coo_rows_local(i) = cur_row
i = i + 1

18
src/xas_tdp_atom.F
View file

@ -521,8 +521,8 @@ CONTAINS
TYPE(cp_1d_i_p_type), DIMENSION(:), OPTIONAL, &
POINTER :: neighbor_set
INTEGER :: blk, i, iat, ibase, iblk, jblk, mepos, &
natom, nb, nbase
INTEGER :: i, iat, ibase, iblk, jblk, mepos, natom, &
nb, nbase
INTEGER, ALLOCATABLE, DIMENSION(:) :: blk_to_base, inb, who_is_there
INTEGER, ALLOCATABLE, DIMENSION(:, :) :: n_neighbors
LOGICAL, ALLOCATABLE, DIMENSION(:) :: is_base_atom
@ -557,7 +557,7 @@ CONTAINS
CALL dbcsr_iterator_start(iter, mat_s)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk, blk=blk)
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk)
!avoid self-neighbors
IF (iblk == jblk) CYCLE
@ -594,7 +594,7 @@ CONTAINS
inb = 1
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk, blk=blk)
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk)
IF (iblk == jblk) CYCLE
!test distance
@ -766,7 +766,7 @@ CONTAINS
CALL dbcsr_iterator_start(iter, whole_s)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row=iat, column=jat, blk=blk)
CALL dbcsr_iterator_next_block(iter, row=iat, column=jat)
CALL dbcsr_get_block_p(whole_s, iat, jat, block_whole, found_whole)
!only interested in neighbors
@ -799,7 +799,7 @@ CONTAINS
CALL dbcsr_iterator_start(iter, ri_sinv)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row=inb, column=jnb, blk=blk)
CALL dbcsr_iterator_next_block(iter, row=inb, column=jnb)
CALL dbcsr_get_block_p(ri_sinv, inb, jnb, block_risinv, found_risinv)
IF (.NOT. found_risinv) CYCLE
@ -3376,8 +3376,8 @@ CONTAINS
CHARACTER(len=*), PARAMETER :: routineN = 'integrate_soc_atoms'
INTEGER :: blk, handle, i, iat, ikind, ir, jat, &
maxso, na, nkind, nr, nset, nsgf
INTEGER :: handle, i, iat, ikind, ir, jat, maxso, &
na, nkind, nr, nset, nsgf
LOGICAL :: all_potential_present
REAL(dp) :: zeff
REAL(dp), ALLOCATABLE, DIMENSION(:) :: Vr
@ -3470,7 +3470,7 @@ CONTAINS
CALL dbcsr_iterator_start(iter, matrix_s(1)%matrix)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row=iat, column=jat, blk=blk)
CALL dbcsr_iterator_next_block(iter, row=iat, column=jat)
IF (.NOT. iat == jat) CYCLE
ikind = particle_set(iat)%atomic_kind%kind_number

17
src/xas_tdp_kernel.F
View file

@ -668,7 +668,7 @@ CONTAINS
TYPE(xas_tdp_control_type), POINTER :: xas_tdp_control
TYPE(qs_environment_type), POINTER :: qs_env
INTEGER :: blk, group, iblk, iso, jblk, jso, nblk, &
INTEGER :: group, iblk, iso, jblk, jso, nblk, &
ndo_mo, ndo_so, nsgfa, nsgfp, ri_atom, &
source
INTEGER, DIMENSION(:), POINTER :: col_dist, col_dist_work, row_dist, &
@ -766,7 +766,7 @@ CONTAINS
CALL dbcsr_iterator_start(iter, abIJ)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk, blk=blk)
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk)
IF (iso == jso .AND. jblk < iblk) CYCLE
CALL dbcsr_get_block_p(abIJ, iblk, jblk, pblock, found)
@ -905,7 +905,7 @@ CONTAINS
INTEGER, INTENT(IN) :: ri_atom
TYPE(qs_environment_type), POINTER :: qs_env
INTEGER :: blk, i, iblk, jblk, n
INTEGER :: i, iblk, jblk, n
LOGICAL :: found
REAL(dp), DIMENSION(:, :), POINTER :: pblock_m, pblock_s
TYPE(dbcsr_distribution_type) :: dist
@ -931,7 +931,7 @@ CONTAINS
CALL dbcsr_iterator_start(iter, template)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk, blk=blk)
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk)
!only have a,b pair if one of them is the ri_atom
IF (iblk .NE. ri_atom .AND. jblk .NE. ri_atom) CYCLE
@ -1268,7 +1268,7 @@ CONTAINS
TYPE(dbcsr_p_type), DIMENSION(:) :: contr_int
REAL(dp), DIMENSION(:, :), INTENT(IN) :: PQ
INTEGER :: blk, iblk, imo, jblk, ndo_mo, s1, s2
INTEGER :: iblk, imo, jblk, ndo_mo, s1, s2
LOGICAL :: found
REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: work
REAL(dp), DIMENSION(:, :), POINTER :: pblock
@ -1282,7 +1282,7 @@ CONTAINS
CALL dbcsr_iterator_start(iter, contr_int(imo)%matrix)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk, blk=blk)
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk)
CALL dbcsr_get_block_p(contr_int(imo)%matrix, iblk, jblk, pblock, found)
IF (found) THEN
@ -1346,8 +1346,7 @@ CONTAINS
REAL(dp), INTENT(IN), OPTIONAL :: eps_filter
LOGICAL, INTENT(IN), OPTIONAL :: mo_transpose
INTEGER :: blk, i, iblk, iso, j, jblk, jso, nblk, &
ndo_so
INTEGER :: i, iblk, iso, j, jblk, jso, nblk, ndo_so
LOGICAL :: found, my_mt
REAL(dp), DIMENSION(:, :), POINTER :: pblock
TYPE(dbcsr_iterator_type) :: iter
@ -1386,7 +1385,7 @@ CONTAINS
CALL dbcsr_iterator_start(iter, prod)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk, blk=blk)
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk)
IF ((iso == jso .AND. jblk < iblk) .AND. .NOT. quadrants(2)) CYCLE
CALL dbcsr_get_block_p(prod, iblk, jblk, pblock, found)

30
src/xas_tdp_utils.F
View file

@ -839,7 +839,7 @@ CONTAINS
CHARACTER(len=*), PARAMETER :: routineN = 'prep_for_ot'
INTEGER :: blk, handle, i, iblk, ido_mo, ispin, jblk, maxel, minel, nao, natom, ndo_mo, &
INTEGER :: handle, i, iblk, ido_mo, ispin, jblk, maxel, minel, nao, natom, ndo_mo, &
nelec_spin(2), nhomo(2), nlumo(2), nspins, start_block, start_col, start_row
LOGICAL :: do_os, found
REAL(dp), DIMENSION(:, :), POINTER :: pblock
@ -924,7 +924,7 @@ CONTAINS
CALL dbcsr_iterator_start(iter, xas_tdp_env%ot_prec(ispin)%matrix)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk, blk=blk)
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk)
CALL dbcsr_get_block_p(xas_tdp_env%ot_prec(ispin)%matrix, iblk, jblk, pblock, found)
@ -1088,7 +1088,7 @@ CONTAINS
CHARACTER(len=*), PARAMETER :: routineN = 'get_q_projector'
INTEGER :: blk, handle, iblk, imo, ispin, jblk, &
INTEGER :: handle, iblk, imo, ispin, jblk, &
nblk_row, ndo_mo, nspins
INTEGER, DIMENSION(:), POINTER :: blk_size_q, row_blk_size
LOGICAL :: found_block, my_dosf
@ -1126,7 +1126,7 @@ CONTAINS
CALL dbcsr_iterator_start(iter, one_sp)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk, blk=blk)
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk)
! get the block
CALL dbcsr_get_block_p(one_sp, iblk, jblk, work_block, found_block)
@ -1176,7 +1176,7 @@ CONTAINS
CHARACTER(len=*), PARAMETER :: routineN = 'build_gs_contribution'
INTEGER :: blk, handle, iblk, imo, ispin, jblk, &
INTEGER :: handle, iblk, imo, ispin, jblk, &
nblk_row, ndo_mo, nspins
INTEGER, DIMENSION(:), POINTER :: blk_size_a, row_blk_size
LOGICAL :: found_block, my_dosf
@ -1228,7 +1228,7 @@ CONTAINS
CALL dbcsr_iterator_start(iter, m_ks(ispin)%matrix)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk, blk=blk)
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk)
! Get the block
CALL dbcsr_get_block_p(m_ks(ispin)%matrix, iblk, jblk, work_block, found_block)
@ -1253,7 +1253,7 @@ CONTAINS
CALL dbcsr_iterator_start(iter, matrix_s(1)%matrix)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk, blk=blk)
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk)
! Get the block
CALL dbcsr_get_block_p(matrix_s(1)%matrix, iblk, jblk, work_block, found_block)
@ -1307,8 +1307,8 @@ CONTAINS
CHARACTER(len=*), PARAMETER :: routineN = 'build_metric'
INTEGER :: blk, handle, i, iblk, jblk, nao, &
nblk_row, ndo_mo, nspins
INTEGER :: handle, i, iblk, jblk, nao, nblk_row, &
ndo_mo, nspins
INTEGER, DIMENSION(:), POINTER :: blk_size_g, row_blk_size
LOGICAL :: found_block, my_do_inv
REAL(dp), DIMENSION(:, :), POINTER :: work_block
@ -1343,7 +1343,7 @@ CONTAINS
CALL dbcsr_iterator_start(iter, matrix_s(1)%matrix)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk, blk=blk)
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk)
! Get the block
CALL dbcsr_get_block_p(matrix_s(1)%matrix, iblk, jblk, work_block, found_block)
@ -1385,7 +1385,7 @@ CONTAINS
CALL dbcsr_iterator_start(iter, matrix_sinv)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk, blk=blk)
CALL dbcsr_iterator_next_block(iter, row=iblk, column=jblk)
! Get the block
CALL dbcsr_get_block_p(matrix_sinv, iblk, jblk, work_block, found_block)
@ -2800,7 +2800,7 @@ CONTAINS
LOGICAL, OPTIONAL :: symmetric
INTEGER, DIMENSION(2), OPTIONAL :: tracea_start, traceb_start
INTEGER :: blk, iex, jex, ndo_mo, ndo_so
INTEGER :: iex, jex, ndo_mo, ndo_so
INTEGER, DIMENSION(2) :: tas, tbs
LOGICAL :: do_diags, found, my_symm
REAL(dp) :: soc_elem
@ -2830,7 +2830,7 @@ CONTAINS
CALL dbcsr_iterator_start(iter, amew_soc)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row=iex, column=jex, blk=blk)
CALL dbcsr_iterator_next_block(iter, row=iex, column=jex)
IF (my_symm .AND. iex > jex) CYCLE
@ -2887,7 +2887,7 @@ CONTAINS
REAL(dp), OPTIONAL :: pref_diags
LOGICAL, OPTIONAL :: symmetric
INTEGER :: blk, iex, jex
INTEGER :: iex, jex
LOGICAL :: do_diags, found, my_symm
REAL(dp) :: soc_elem
REAL(dp), ALLOCATABLE, DIMENSION(:) :: diag
@ -2905,7 +2905,7 @@ CONTAINS
CALL dbcsr_iterator_start(iter, amew_soc)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row=iex, column=jex, blk=blk)
CALL dbcsr_iterator_next_block(iter, row=iex, column=jex)
IF (my_symm .AND. iex > jex) CYCLE