diff --git a/src/efield_tb_methods.F b/src/efield_tb_methods.F index 7cddb615cf..06384e0ae5 100644 --- a/src/efield_tb_methods.F +++ b/src/efield_tb_methods.F @@ -73,7 +73,7 @@ CONTAINS TYPE(qs_environment_type), POINTER :: qs_env TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: ks_matrix TYPE(qs_rho_type), POINTER :: rho - REAL(dp), DIMENSION(:) :: mcharge + REAL(dp), DIMENSION(:), INTENT(in) :: mcharge TYPE(qs_energy_type), POINTER :: energy LOGICAL, INTENT(in) :: calculate_forces, just_energy @@ -121,7 +121,7 @@ CONTAINS TYPE(qs_environment_type), POINTER :: qs_env TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: ks_matrix TYPE(qs_rho_type), POINTER :: rho - REAL(dp), DIMENSION(:) :: mcharge + REAL(dp), DIMENSION(:), INTENT(in) :: mcharge TYPE(qs_energy_type), POINTER :: energy LOGICAL, INTENT(in) :: calculate_forces, just_energy @@ -270,7 +270,7 @@ CONTAINS TYPE(qs_environment_type), POINTER :: qs_env TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: ks_matrix TYPE(qs_rho_type), POINTER :: rho - REAL(dp), DIMENSION(:) :: mcharge + REAL(dp), DIMENSION(:), INTENT(in) :: mcharge TYPE(qs_energy_type), POINTER :: energy LOGICAL, INTENT(in) :: calculate_forces, just_energy @@ -522,7 +522,7 @@ CONTAINS TYPE(qs_environment_type), POINTER :: qs_env TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: ks_matrix TYPE(qs_rho_type), POINTER :: rho - REAL(dp), DIMENSION(:) :: mcharge + REAL(dp), DIMENSION(:), INTENT(in) :: mcharge TYPE(qs_energy_type), POINTER :: energy LOGICAL, INTENT(in) :: calculate_forces, just_energy diff --git a/src/emd/rt_propagation_methods.F b/src/emd/rt_propagation_methods.F index 1048c5093d..8c246c63b8 100644 --- a/src/emd/rt_propagation_methods.F +++ b/src/emd/rt_propagation_methods.F @@ -741,7 +741,7 @@ CONTAINS ncol_local=ncol_local) CALL cp_fm_struct_create(matrix_struct_new, & - template_fmstruct=matrix_struct, & + template_fmstruct=mos_new(2*i)%matrix%matrix_struct, & nrow_global=k, & ncol_global=k) CALL cp_cfm_create(csc, matrix_struct_new) @@ -752,7 +752,6 @@ CONTAINS ! first the most recent ! reorthogonalize vectors - DO icol_local = 1, ncol_local fm_tmp%local_data(:, icol_local) = mos_new(2*i - 1)%matrix%local_data(:, icol_local) fm_tmp%local_data(:, icol_local + ncol_local) = mos_new(2*i)%matrix%local_data(:, icol_local) diff --git a/src/ewald_methods_tb.F b/src/ewald_methods_tb.F index 6760326266..b292f5f355 100644 --- a/src/ewald_methods_tb.F +++ b/src/ewald_methods_tb.F @@ -88,7 +88,7 @@ CONTAINS TYPE(particle_type), DIMENSION(:), INTENT(IN) :: particle_set TYPE(cell_type), POINTER :: box REAL(KIND=dp), DIMENSION(:, :), INTENT(inout) :: gmcharge - REAL(KIND=dp), DIMENSION(:), INTENT(inout) :: mcharge + REAL(KIND=dp), DIMENSION(:), INTENT(in) :: mcharge LOGICAL, INTENT(in) :: calculate_forces TYPE(virial_type), POINTER :: virial LOGICAL, INTENT(in) :: use_virial diff --git a/src/fm/cp_fm_struct.F b/src/fm/cp_fm_struct.F index 660d8bb963..1a14fabc99 100644 --- a/src/fm/cp_fm_struct.F +++ b/src/fm/cp_fm_struct.F @@ -559,13 +559,14 @@ CONTAINS SUBROUTINE cp_fm_struct_double(fmstruct, struct, context, col, row) TYPE(cp_fm_struct_type), POINTER :: fmstruct, struct TYPE(cp_blacs_env_type), POINTER :: context - LOGICAL :: col, row + LOGICAL, INTENT(in) :: col, row CHARACTER(len=*), PARAMETER :: routineN = 'cp_fm_struct_double', & routineP = moduleN//':'//routineN - INTEGER :: nblocks, ncol_block, ncol_global, nempty, newdim_col, newdim_row, nfilled, & - nprocs_col, nprocs_row, nrow_block, nrow_global + INTEGER :: n_doubled_items_in_partially_filled_block, ncol_block, ncol_global, newdim_col, & + newdim_row, nfilled_blocks, nfilled_blocks_remain, nprocs_col, nprocs_row, nrow_block, & + nrow_global TYPE(cp_para_env_type), POINTER :: para_env CALL cp_fm_struct_get(struct, nrow_global=nrow_global, & @@ -581,11 +582,38 @@ CONTAINS IF (ncol_global == 0) THEN newdim_col = 0 ELSE - !Divide ncol_global by ncol_block and round up - nblocks = (ncol_global + ncol_block - 1)/ncol_block - nfilled = MOD(nblocks, nprocs_col) - nempty = MOD(nprocs_col - nfilled, nprocs_col) - newdim_col = 2*ncol_global + 2*nempty*ncol_block + 2*MOD(ncol_block - MOD(ncol_global, ncol_block), ncol_block) + ! ncol_block nfilled_blocks_remain * ncol_block + ! |<--->| |<--->| + ! |-----|-----|-----|-----|---| + ! | 0 | 1 | 2 | 0 | 1 | <- context%mepos(2) + ! |-----|-----|-----|-----|---| + ! |<--- nfilled_blocks -->|<-> -- items (columns) in partially filled blocks + ! | * ncol_block | + n_doubled_items_in_partially_filled_block = 2*MOD(ncol_global, ncol_block) + nfilled_blocks = ncol_global/ncol_block + nfilled_blocks_remain = MOD(nfilled_blocks, nprocs_col) + newdim_col = 2*(nfilled_blocks/nprocs_col) + IF (n_doubled_items_in_partially_filled_block > ncol_block) THEN + ! doubled number of columns in a partially filled block does not fit into a single block. + ! Due to cyclic distribution of ScaLAPACK blocks, an extra block for each core needs to be added + ! |-----|-----|-----|----| |-----|-----|-----|-----|-----|-----|-----|-----|-----|---| + ! | 0 | 1 | 2 | 0 | --> | 0 | 1 | 2 | 0 | 1 | 2 | 0 | 1 | 2 | 0| + ! |-----|-----|-----|----| |-----|-----|-----|-----|-----|-----|-----|-----|-----|---| + ! a a a b a1 a1 a1 a2 a2 a2 b1 empty empty b2 + newdim_col = newdim_col + 1 + + ! the number of columns which does not fit into the added extra block + n_doubled_items_in_partially_filled_block = n_doubled_items_in_partially_filled_block - ncol_block + ELSE IF (nfilled_blocks_remain > 0) THEN + ! |-----|-----|-----|-----|--| |-----|-----|-----|-----|-----|-----|-----|-----|-----|-----| + ! | 0 | 1 | 2 | 0 | 1| -> | 0 | 1 | 2 | 0 | 1 | 2 | 0 | 1 | 2 | 0 | + ! |-----|-----|-----|-----|--| |-----|-----|-----|-----|-----|-----|-----|-----|-----|-----| + ! a a a b b a1 a1 a1 a2 a2 a2 b1 b1 b2 empty b2 + newdim_col = newdim_col + 1 + n_doubled_items_in_partially_filled_block = 0 + END IF + + newdim_col = (newdim_col*nprocs_col + nfilled_blocks_remain)*ncol_block + n_doubled_items_in_partially_filled_block END IF END IF @@ -593,20 +621,31 @@ CONTAINS IF (nrow_global == 0) THEN newdim_row = 0 ELSE - !Divide nrow_global by nrow_block and round up - nblocks = (nrow_global + nrow_block - 1)/nrow_block - nfilled = MOD(nblocks, nprocs_row) - nempty = MOD(nprocs_row - nfilled, nprocs_row) - newdim_row = 2*nrow_global + 2*nempty*nrow_block + 2*MOD(nrow_block - MOD(nrow_global, nrow_block), nrow_block) + n_doubled_items_in_partially_filled_block = 2*MOD(nrow_global, nrow_block) + nfilled_blocks = nrow_global/nrow_block + nfilled_blocks_remain = MOD(nfilled_blocks, nprocs_row) + newdim_row = 2*(nfilled_blocks/nprocs_row) + IF (n_doubled_items_in_partially_filled_block > nrow_block) THEN + newdim_row = newdim_row + 1 + n_doubled_items_in_partially_filled_block = n_doubled_items_in_partially_filled_block - nrow_block + ELSE IF (nfilled_blocks_remain > 0) THEN + newdim_row = newdim_row + 1 + n_doubled_items_in_partially_filled_block = 0 + END IF + + newdim_row = (newdim_row*nprocs_row + nfilled_blocks_remain)*nrow_block + n_doubled_items_in_partially_filled_block END IF END IF + ! square_blocks=.FALSE. ensures that matrix blocks of the doubled matrix will have + ! nrow_block x ncol_block shape even in case of a square doubled matrix CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, & context=context, & nrow_global=newdim_row, & ncol_global=newdim_col, & ncol_block=ncol_block, & - nrow_block=nrow_block) + nrow_block=nrow_block, & + square_blocks=.FALSE.) END SUBROUTINE cp_fm_struct_double ! ************************************************************************************************** diff --git a/src/qs_dftb3_methods.F b/src/qs_dftb3_methods.F index 8bf0963fbc..be0703856c 100644 --- a/src/qs_dftb3_methods.F +++ b/src/qs_dftb3_methods.F @@ -74,9 +74,9 @@ CONTAINS TYPE(qs_environment_type), POINTER :: qs_env TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: ks_matrix TYPE(qs_rho_type), POINTER :: rho - REAL(dp), DIMENSION(:) :: mcharge + REAL(dp), DIMENSION(:), INTENT(in) :: mcharge TYPE(qs_energy_type), POINTER :: energy - REAL(dp), DIMENSION(:) :: xgamma, zeff + REAL(dp), DIMENSION(:), INTENT(in) :: xgamma, zeff TYPE(sap_int_type), DIMENSION(:), POINTER :: sap_int LOGICAL, INTENT(in) :: calculate_forces, just_energy diff --git a/src/qs_dispersion_pairpot.F b/src/qs_dispersion_pairpot.F index 4475e7c9e4..fa46674ed6 100644 --- a/src/qs_dispersion_pairpot.F +++ b/src/qs_dispersion_pairpot.F @@ -900,6 +900,8 @@ CONTAINS TYPE(virial_type), POINTER :: virial energy = 0._dp + ! make valgrind happy + use_virial = .FALSE. IF (dispersion_env%type .NE. xc_vdw_fun_pairpot) THEN RETURN diff --git a/src/xtb_coulomb.F b/src/xtb_coulomb.F index f0fbc0b26e..3e9daa9e2d 100644 --- a/src/xtb_coulomb.F +++ b/src/xtb_coulomb.F @@ -102,8 +102,8 @@ CONTAINS TYPE(qs_environment_type), POINTER :: qs_env TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: ks_matrix TYPE(qs_rho_type), POINTER :: rho - REAL(dp), DIMENSION(:, :) :: charges - REAL(dp), DIMENSION(:) :: mcharge + REAL(dp), DIMENSION(:, :), INTENT(in) :: charges + REAL(dp), DIMENSION(:), INTENT(in) :: mcharge TYPE(qs_energy_type), POINTER :: energy LOGICAL, INTENT(in) :: calculate_forces, just_energy diff --git a/src/xtb_matrices.F b/src/xtb_matrices.F index 51e30c83d6..fafdcd84b9 100644 --- a/src/xtb_matrices.F +++ b/src/xtb_matrices.F @@ -1031,7 +1031,7 @@ CONTAINS ELSE p_matrix => matrix_p(:, 1) s_matrix => matrix_s(1, 1)%matrix - CALL ao_charges(matrix_p, matrix_s, aocg, para_env) + CALL ao_charges(p_matrix, s_matrix, aocg, para_env) END IF DO ikind = 1, nkind CALL get_atomic_kind(atomic_kind_set(ikind), natom=na)