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

Fast index first and removed unused variables (#4220)

Browse source
This commit is contained in:
Hans Pabst 2025-05-26 12:56:26 +02:00 • committed by GitHub
parent f0f16071bc
commit 683bb26b40
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
3 changed files with 36 additions and 50 deletions
Download patch file Download diff file Expand all files Collapse all files

7
src/fm/cp_fm_cholesky.F
View file

@ -119,10 +119,9 @@ CONTAINS
IF (PRESENT(info_out)) THEN
info_out = info
ELSE
IF (info /= 0) &
CALL cp_abort(__LOCATION__, &
"Cholesky decompose failed: the matrix is not positive definite or ill-conditioned.")
ELSE IF (info /= 0) THEN
CALL cp_abort(__LOCATION__, &
"Cholesky decompose failed: the matrix is not positive definite or ill-conditioned.")
END IF
CALL timestop(handle)

57
src/mp2_ri_2c.F
View file

@ -452,8 +452,8 @@ CONTAINS
nkp = kpoints%nkp
ALLOCATE (fm_matrix_L_kpoints(nkp, 2))
DO ikp = 1, nkp
DO i_real_imag = 1, 2
DO i_real_imag = 1, 2
DO ikp = 1, nkp
CALL cp_fm_create(fm_matrix_L_kpoints(ikp, i_real_imag), &
fm_matrix_Minv_L_kpoints(1, i_real_imag)%matrix_struct)
CALL cp_fm_set_all(fm_matrix_L_kpoints(ikp, i_real_imag), 0.0_dp)
@ -695,8 +695,8 @@ CONTAINS
IF (PRESENT(ikp_ext)) nkp = 1
ALLOCATE (fm_matrix_Minv_L_kpoints(nkp, n_real_imag))
DO i_size = 1, nkp
DO i_real_imag = 1, n_real_imag
DO i_real_imag = 1, n_real_imag
DO i_size = 1, nkp
CALL cp_fm_create(fm_matrix_Minv_L_kpoints(i_size, i_real_imag), fm_matrix_L%matrix_struct)
CALL cp_fm_set_all(fm_matrix_Minv_L_kpoints(i_size, i_real_imag), 0.0_dp)
END DO
@ -1224,8 +1224,8 @@ CONTAINS
CHARACTER(LEN=*), PARAMETER :: routineN = 'fill_fm_L_from_L_loc_non_blocking'
INTEGER :: dummy_proc, handle, handle2, i_entry_rec, i_row, i_row_global, iproc, j_col, &
j_col_global, LLL, MMM, ncol_local, nrow_local, proc_send, send_pcol, send_prow
INTEGER :: dummy_proc, handle, handle2, i_entry_rec, i_row, iproc, j_col, LLL, MMM, &
ncol_local, nrow_local, proc_send, send_pcol, send_prow
INTEGER, ALLOCATABLE, DIMENSION(:) :: entry_counter, num_entries_rec, &
num_entries_send
INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices
@ -1333,13 +1333,13 @@ CONTAINS
! get the process, where the elements from L_local_col have to be sent and
! write the data and the info to buffer_send
DO LLL = 1, dimen_RI
DO MMM = my_group_L_start, my_group_L_end
send_prow = fm_matrix_L%matrix_struct%g2p_row(LLL)
send_pcol = fm_matrix_L%matrix_struct%g2p_col(MMM)
DO MMM = my_group_L_start, my_group_L_end
DO LLL = 1, dimen_RI
send_pcol = fm_matrix_L%matrix_struct%g2p_col(MMM)
send_prow = fm_matrix_L%matrix_struct%g2p_row(LLL)
proc_send = fm_matrix_L%matrix_struct%context%blacs2mpi(send_prow, send_pcol)
@ -1373,30 +1373,17 @@ CONTAINS
! fill fm_matrix_L with the entries from buffer_rec
DO iproc = 0, para_env%num_pe - 1
DO i_entry_rec = 1, num_entries_rec(iproc)
DO i_row = 1, nrow_local
i_row_global = row_indices(i_row)
DO j_col = 1, ncol_local
j_col_global = col_indices(j_col)
IF (i_row_global == buffer_rec(iproc)%indx(i_entry_rec, 1) .AND. &
j_col_global == buffer_rec(iproc)%indx(i_entry_rec, 2)) THEN
fm_matrix_L%local_data(i_row, j_col) = buffer_rec(iproc)%msg(i_entry_rec)
END IF
END DO
DO j_col = 1, ncol_local
IF (col_indices(j_col) == buffer_rec(iproc)%indx(i_entry_rec, 2)) THEN
DO i_row = 1, nrow_local
IF (row_indices(i_row) == buffer_rec(iproc)%indx(i_entry_rec, 1)) THEN
fm_matrix_L%local_data(i_row, j_col) = buffer_rec(iproc)%msg(i_entry_rec)
END IF
END DO
END IF
END DO
END DO
END DO
CALL timestop(handle2)
@ -1452,10 +1439,10 @@ CONTAINS
ncol_local=ncol_local, &
row_indices=row_indices, &
col_indices=col_indices)
DO iiB = 1, nrow_local
i_global = row_indices(iiB)
DO jjB = 1, ncol_local
j_global = col_indices(jjB)
DO jjB = 1, ncol_local
j_global = col_indices(jjB)
DO iiB = 1, nrow_local
i_global = row_indices(iiB)
IF (j_global < i_global) fm_matrix_L%local_data(iiB, jjB) = 0.0_dp
END DO
END DO

22
src/rpa_util.F
View file

@ -412,8 +412,8 @@ CONTAINS
CALL cp_fm_to_fm(mo_coeff, fm_mo_coeff_occ)
! set all virtual MO coeffs to zero
DO irow_global = 1, nmo
DO icol_global = homo + 1, nmo
DO icol_global = homo + 1, nmo
DO irow_global = 1, nmo
CALL cp_fm_set_element(fm_mo_coeff_occ, irow_global, icol_global, 0.0_dp)
END DO
END DO
@ -423,8 +423,8 @@ CONTAINS
CALL cp_fm_to_fm(mo_coeff, fm_mo_coeff_virt)
! set all occupied MO coeffs to zero
DO irow_global = 1, nmo
DO icol_global = 1, homo
DO icol_global = 1, homo
DO irow_global = 1, nmo
CALL cp_fm_set_element(fm_mo_coeff_virt, irow_global, icol_global, 0.0_dp)
END DO
END DO
@ -520,8 +520,8 @@ CONTAINS
! Start to allocate the new full matrix
ALLOCATE (fm_mat_L(SIZE(fm_matrix_Minv_L_kpoints, 1), SIZE(fm_matrix_Minv_L_kpoints, 2)))
DO ikp = 1, SIZE(fm_matrix_Minv_L_kpoints, 1)
DO j_size = 1, SIZE(fm_matrix_Minv_L_kpoints, 2)
DO j_size = 1, SIZE(fm_matrix_Minv_L_kpoints, 2)
DO ikp = 1, SIZE(fm_matrix_Minv_L_kpoints, 1)
IF (do_kpoints) THEN
IF (ikp == first_ikp_local .OR. ikp_local == -1) THEN
CALL cp_fm_create(fm_mat_L(ikp, j_size), fm_struct_sub_kp)
@ -557,8 +557,8 @@ CONTAINS
! For k-points copy matrices of your group
! Without kpoints, transpose matrix
! without kpoints, the size of fm_mat_L is 1x1. with kpoints, the size is N_kpoints x 2 (2 for real/complex)
DO ikp = 1, SIZE(fm_matrix_Minv_L_kpoints, 1)
DO j_size = 1, SIZE(fm_matrix_Minv_L_kpoints, 2)
DO ikp = 1, SIZE(fm_matrix_Minv_L_kpoints, 1)
IF (do_kpoints) THEN
IF (ikp_local == ikp .OR. ikp_local == -1) THEN
CALL cp_fm_copy_general(fm_matrix_Minv_L_kpoints(ikp, j_size), fm_mat_L_transposed, para_env)
@ -1207,8 +1207,8 @@ CONTAINS
DEALLOCATE (mat_P_omega)
END IF
DO i_size = 1, SIZE(t_3c_O, 1)
DO j_size = 1, SIZE(t_3c_O, 2)
DO j_size = 1, SIZE(t_3c_O, 2)
DO i_size = 1, SIZE(t_3c_O, 1)
CALL dbt_destroy(t_3c_O(i_size, j_size))
END DO
END DO
@ -1228,9 +1228,9 @@ CONTAINS
cut_memory = SIZE(t_3c_O_compressed, 3)
DEALLOCATE (t_3c_O_ind)
DO i_size = 1, SIZE(t_3c_O_compressed, 1)
DO i_mem = 1, cut_memory
DO j_size = 1, SIZE(t_3c_O_compressed, 2)
DO i_mem = 1, cut_memory
DO i_size = 1, SIZE(t_3c_O_compressed, 1)
CALL dealloc_containers(t_3c_O_compressed(i_size, j_size, i_mem), unused)
END DO
END DO