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

Fix cp_fm_struct_double. Add missing INTENT statements

Browse source
This commit is contained in:
Sergey Chulkov 2019-12-20 17:17:38 +00:00
parent 2e6b69139d
commit e63559925b
8 changed files with 66 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

8
src/efield_tb_methods.F
View file

@ -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

3
src/emd/rt_propagation_methods.F
View file

@ -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)

2
src/ewald_methods_tb.F
View file

@ -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

67
src/fm/cp_fm_struct.F
View file

@ -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
! **************************************************************************************************

4
src/qs_dftb3_methods.F
View file

@ -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

2
src/qs_dispersion_pairpot.F
View file

@ -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

4
src/xtb_coulomb.F
View file

@ -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

2
src/xtb_matrices.F
View file

@ -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)