https://gcc.gnu.org/bugzilla/show_bug.cgi?id=125267
--- Comment #11 from Jürgen Reuter <juergen.reuter at desy dot de> ---
Here is a short reproducer, cf. below. In the meantime we checked that all our
failures in our testsuite are due to -fcheck=bounds flag.
So probably this is indeed another incarnation of issue 125192.
module polarizations
implicit none
private
public :: pmatrix_t
type :: pmatrix_t
private
integer :: dim = 0
integer :: n_entry = 0
integer, dimension(:,:), allocatable :: index
complex, dimension(:), allocatable :: value
contains
procedure :: init => pmatrix_init
procedure :: set_entry => pmatrix_set_entry
procedure :: normalize => pmatrix_normalize
end type pmatrix_t
contains
subroutine pmatrix_init (pmatrix, dim, n_entry)
class(pmatrix_t), intent(out) :: pmatrix
integer, intent(in) :: dim
integer, intent(in) :: n_entry
pmatrix%dim = dim
pmatrix%n_entry = n_entry
allocate (pmatrix%index (dim, n_entry))
allocate (pmatrix%value (n_entry))
end subroutine pmatrix_init
subroutine pmatrix_set_entry (pmatrix, i, index, value)
class(pmatrix_t), intent(inout) :: pmatrix
integer, intent(in) :: i
integer, dimension(:), intent(in) :: index
complex, intent(in) :: value
pmatrix%index(:,i) = index
pmatrix%value(i) = value
end subroutine pmatrix_set_entry
subroutine pmatrix_normalize (pmatrix)
class(pmatrix_t), intent(inout) :: pmatrix
integer :: i
real :: trace
trace = 0
do i = 1, pmatrix%n_entry
associate (index => pmatrix%index(:,i), value => pmatrix%value(i))
if (index(1) == index(2)) then
trace = trace + value
else if (any (pmatrix%index(1,:) == index(2) &
.and. pmatrix%index(2,:) == index(1))) then
print *, "redundant off-diagonal entry"
else if (index(2) < index (1)) then
index = index([2,1])
value = conjg (value)
end if
end associate
end do
end subroutine pmatrix_normalize
end module polarizations
program main_ut
use polarizations
implicit none
type(pmatrix_t) :: pmatrix
call pmatrix%init (2, 3)
call pmatrix%set_entry (1, [-1,-1], (1., 0.))
call pmatrix%set_entry (2, [+1,+1], (1., 0.))
call pmatrix%set_entry (3, [-1,+1], (1., 0.))
call pmatrix%normalize ()
end program main_ut
