Fix issue with access to unallocated arrays

This fixes segmentation faults introduced by PR cp2k#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.

src/ewalds.F

@@ -114,8 +114,8 @@ SUBROUTINE ewald_evaluate(ewald_env, ewald_pw, cell, atomic_kind_set, particle_s
 
       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 @@ SUBROUTINE ewald_self(ewald_env, cell, atomic_kind_set, local_particles, e_self,
             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

src/pme.F

@@ -107,7 +107,7 @@ SUBROUTINE pme_evaluate(ewald_env, ewald_pw, box, particle_set, vg_coulomb, &
       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 @@ SUBROUTINE get_patch(dg, particle_set, exp_igr, box, p1, p2, &
       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 @@ SUBROUTINE get_patch(dg, particle_set, exp_igr, box, p1, p2, &
       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 @@ SUBROUTINE get_patch_again(dg, particle_set, exp_igr, p1, p2, rhos1, rhos2, is1_
       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 @@ SUBROUTINE get_patch_again(dg, particle_set, exp_igr, p1, p2, rhos1, rhos2, is1_
       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

src/spme.F

@@ -105,7 +105,7 @@ SUBROUTINE spme_evaluate(ewald_env, ewald_pw, box, particle_set, &
       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 @@ SUBROUTINE spme_potential(ewald_env, ewald_pw, box, particle_set_a, charges_a, &
       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 @@ SUBROUTINE spme_forces(ewald_env, ewald_pw, box, particle_set_a, charges_a, &
       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 @@ SUBROUTINE get_patch_a(part, delta, green, p, rhos, is_core, is_shell, &
       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 @@ SUBROUTINE get_patch_a(part, delta, green, p, rhos, is_core, is_shell, &
       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 @@ SUBROUTINE get_patch_b(part, delta, green, p, rhos, charges)
       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)