diff --git a/src/fm/cp_fm_cholesky.F b/src/fm/cp_fm_cholesky.F index 8c3569d1fc..3cf6072105 100644 --- a/src/fm/cp_fm_cholesky.F +++ b/src/fm/cp_fm_cholesky.F @@ -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) diff --git a/src/mp2_ri_2c.F b/src/mp2_ri_2c.F index d09452444b..505c3c955c 100644 --- a/src/mp2_ri_2c.F +++ b/src/mp2_ri_2c.F @@ -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 diff --git a/src/rpa_util.F b/src/rpa_util.F index 0e9ca18b0f..408377a40c 100644 --- a/src/rpa_util.F +++ b/src/rpa_util.F @@ -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