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 issue with access to unallocated arrays

Browse source 
This fixes segmentation faults introduced by PR #3548 which were detected by the AMD AOCC compiler 5.0.0.
Keeping the POINTER attribute is required for checking the association status of the optional argument charges.
This commit is contained in:
Matthias Krack 2024-10-22 09:54:24 +02:00
parent a1c7dd2a71
commit 7a99649828
3 changed files with 19 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/ewalds.F
View file

@ -114,8 +114,8 @@ CONTAINS
CALL timeset(routineN, handle)
CALL cite_reference(Ewald1921)
use_charge_array = PRESENT(charges)
IF (use_charge_array) use_charge_array = ASSOCIATED(charges)
use_charge_array = .FALSE.
IF (PRESENT(charges)) use_charge_array = ASSOCIATED(charges)
atenergy = PRESENT(e_coulomb)
IF (atenergy) atenergy = ASSOCIATED(e_coulomb)
IF (atenergy) e_coulomb = 0._dp
@ -333,7 +333,7 @@ CONTAINS
atomic_kind => atomic_kind_set(iparticle_kind)
CALL get_atomic_kind(atomic_kind=atomic_kind, mm_radius=mm_radius)
IF (mm_radius > 0.0_dp) THEN
CPABORT("Array of charges not implemented for mm_radius>0.0 !!")
CPABORT("Array of charges not implemented for mm_radius > 0.0")
END IF
END DO
ELSE

12
src/pme.F
View file

@ -107,7 +107,7 @@ CONTAINS
REAL(KIND=dp), DIMENSION(:, :), INTENT(OUT), &
OPTIONAL :: fgshell_coulomb, fgcore_coulomb
LOGICAL, INTENT(IN) :: use_virial
REAL(KIND=dp), DIMENSION(:), INTENT(IN), OPTIONAL :: charges
REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: charges
TYPE(atprop_type), POINTER :: atprop
CHARACTER(LEN=*), PARAMETER :: routineN = 'pme_evaluate'
@ -504,7 +504,7 @@ CONTAINS
LOGICAL, OPTIONAL :: is1_core, is2_core, is1_shell, is2_shell
TYPE(particle_type), DIMENSION(:), OPTIONAL, &
POINTER :: core_particle_set
REAL(KIND=dp), DIMENSION(:), INTENT(IN), OPTIONAL :: charges
REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: charges
COMPLEX(KIND=dp), DIMENSION(:), POINTER :: ex1, ex2, ey1, ey2, ez1, ez2
INTEGER, DIMENSION(:), POINTER :: center1, center2
@ -518,7 +518,8 @@ CONTAINS
TYPE(shell_kind_type), POINTER :: shell
NULLIFY (shell)
use_charge_array = PRESENT(charges)
use_charge_array = .FALSE.
IF (PRESENT(charges)) use_charge_array = ASSOCIATED(charges)
my_is1_core = .FALSE.
my_is2_core = .FALSE.
IF (PRESENT(is1_core)) my_is1_core = is1_core
@ -646,7 +647,7 @@ CONTAINS
INTEGER, INTENT(IN) :: p1, p2
TYPE(pw_r3d_rs_type), INTENT(INOUT) :: rhos1, rhos2
LOGICAL, OPTIONAL :: is1_core, is2_core, is1_shell, is2_shell
REAL(KIND=dp), DIMENSION(:), INTENT(IN), OPTIONAL :: charges
REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: charges
COMPLEX(KIND=dp), DIMENSION(:), POINTER :: ex1, ex2, ey1, ey2, ez1, ez2
LOGICAL :: my_is1_core, my_is1_shell, my_is2_core, &
@ -658,7 +659,8 @@ CONTAINS
TYPE(shell_kind_type), POINTER :: shell
NULLIFY (shell)
use_charge_array = PRESENT(charges)
use_charge_array = .FALSE.
IF (PRESENT(charges)) use_charge_array = ASSOCIATED(charges)
my_is1_core = .FALSE.
my_is2_core = .FALSE.
IF (PRESENT(is1_core)) my_is1_core = is1_core

16
src/spme.F
View file

@ -105,7 +105,7 @@ CONTAINS
REAL(KIND=dp), DIMENSION(:, :), INTENT(OUT), &
OPTIONAL :: fgshell_coulomb, fgcore_coulomb
LOGICAL, INTENT(IN) :: use_virial
REAL(KIND=dp), DIMENSION(:), INTENT(IN), OPTIONAL :: charges
REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: charges
TYPE(atprop_type), POINTER :: atprop
CHARACTER(len=*), PARAMETER :: routineN = 'spme_evaluate'
@ -469,7 +469,7 @@ CONTAINS
TYPE(ewald_pw_type), POINTER :: ewald_pw
TYPE(cell_type), POINTER :: box
TYPE(particle_type), DIMENSION(:), INTENT(IN) :: particle_set_a
REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: charges_a
REAL(KIND=dp), DIMENSION(:), INTENT(IN), POINTER :: charges_a
TYPE(particle_type), DIMENSION(:), INTENT(IN) :: particle_set_b
REAL(KIND=dp), DIMENSION(:), INTENT(INOUT) :: potential
@ -610,9 +610,9 @@ CONTAINS
TYPE(ewald_pw_type), POINTER :: ewald_pw
TYPE(cell_type), POINTER :: box
TYPE(particle_type), DIMENSION(:), INTENT(IN) :: particle_set_a
REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: charges_a
REAL(KIND=dp), DIMENSION(:), INTENT(IN), POINTER :: charges_a
TYPE(particle_type), DIMENSION(:), INTENT(IN) :: particle_set_b
REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: charges_b
REAL(KIND=dp), DIMENSION(:), INTENT(IN), POINTER :: charges_b
REAL(KIND=dp), DIMENSION(:, :), INTENT(INOUT) :: forces_b
CHARACTER(len=*), PARAMETER :: routineN = 'spme_forces'
@ -770,7 +770,7 @@ CONTAINS
INTEGER, INTENT(IN) :: p
REAL(KIND=dp), DIMENSION(:, :, :), INTENT(OUT) :: rhos
LOGICAL, INTENT(IN) :: is_core, is_shell, unit_charge
REAL(KIND=dp), DIMENSION(:), INTENT(IN), OPTIONAL :: charges
REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: charges
INTEGER :: nbox
LOGICAL :: use_charge_array
@ -779,7 +779,8 @@ CONTAINS
TYPE(shell_kind_type), POINTER :: shell
NULLIFY (shell)
use_charge_array = PRESENT(charges)
use_charge_array = .FALSE.
IF (PRESENT(charges)) use_charge_array = ASSOCIATED(charges)
IF (is_core .AND. is_shell) THEN
CPABORT("Shell-model: cannot be core and shell simultaneously")
END IF
@ -822,12 +823,13 @@ CONTAINS
TYPE(greens_fn_type), INTENT(IN) :: green
INTEGER, INTENT(IN) :: p
REAL(KIND=dp), DIMENSION(:, :, :), INTENT(OUT) :: rhos
REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: charges
REAL(KIND=dp), DIMENSION(:), POINTER :: charges
INTEGER :: nbox
REAL(KIND=dp) :: q
REAL(KIND=dp), DIMENSION(3) :: r
CPASSERT(ASSOCIATED(charges))
nbox = SIZE(rhos, 1)
r = part(p)%r
q = charges(p)