- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
The following code leads to an free invalid pointer exception with the following backtrace:
#0 __pthread_kill_implementation (threadid=<optimized out>, signo=signo@entry=6, no_tid=no_tid@entry=0) at pthread_kill.c:44
#1 0x00007ffff7c8b9b3 in __pthread_kill_internal (signo=6, threadid=<optimized out>) at pthread_kill.c:78
#2 0x00007ffff7c3e646 in __GI_raise (sig=sig@entry=6) at ../sysdeps/posix/raise.c:26
#3 0x00007ffff7c287f3 in __GI_abort () at abort.c:79
#4 0x00007ffff7c29130 in __libc_message (fmt=<optimized out>, fmt@entry=0x7ffff7dbb6a8 "%s\n") at ../sysdeps/posix/libc_fatal.c:150
#5 0x00007ffff7c959f7 in malloc_printerr (str=str@entry=0x7ffff7db91e7 "free(): invalid pointer") at malloc.c:5515
#6 0x00007ffff7c972ac in _int_free (av=<optimized out>, p=<optimized out>, have_lock=0) at malloc.c:4306
#7 0x00007ffff7c99d35 in __GI___libc_free (mem=<optimized out>) at malloc.c:3258
#8 0x000000000041ff2e in for_deallocate_handle ()
#9 0x0000000000406a0b in bloch_vectors_mp_bloch_vector_to_matrix_ ()
#10 0x000000000040575d in bloch_vectors_utibloch_vectors_3_mp_bloch_arbitrary_ ()
#11 0x00000000004043e0 in bloch_vectors_uti_mp_bloch_vectors_3_ ()
#12 0x00000000004041fe in MAIN__ ()
#13 0x00000000004041ad in main ()still was still working in ifort 2021.10.0 from June 2023.
This is the reproducer:
module kinds
use, intrinsic :: iso_fortran_env
use, intrinsic :: iso_c_binding
implicit none
private
integer, parameter :: single = 4 ! 1.. 6 ! real32 ! c_float
integer, parameter :: double = 8 ! 7..15 ! real64 ! c_double
public :: single, double
public :: default
integer, parameter :: default = double
end module kinds
module physics_defs
implicit none
private
integer, parameter, public :: UNDEFINED = 0
integer, parameter, public:: UNKNOWN = 0
integer, parameter, public :: SCALAR = 1, SPINOR = 2, VECTOR = 3, &
VECTORSPINOR = 4, TENSOR = 5
end module physics_defs
module su_algebra
use kinds, only: default
implicit none
private
public :: algebra_dimension
public :: fundamental_dimension
public :: helicity_value
public :: helicity_index
public :: is_cartan_generator
public :: cartan_index
public :: cartan_element
public :: cartan_coeff
public :: root_index
public :: root_helicity
interface
module function algebra_dimension (s) result (n)
integer :: n
integer, intent(in) :: s
end function algebra_dimension
module function fundamental_dimension (s) result (d)
integer :: d
integer, intent(in) :: s
end function fundamental_dimension
module function helicity_value (s, i) result (h)
integer :: h
integer, intent(in) :: s, i
end function helicity_value
module function helicity_index (s, h) result (i)
integer, intent(in) :: s, h
integer :: i
end function helicity_index
elemental module function is_cartan_generator (s, i) result (cartan)
logical :: cartan
integer, intent(in) :: s, i
end function is_cartan_generator
elemental module function cartan_index (s, k) result (ci)
integer :: ci
integer, intent(in) :: s, k
end function cartan_index
module function cartan_element (s, h) result (a)
real(default), dimension(:), allocatable :: a
integer, intent(in) :: s, h
end function cartan_element
module function cartan_coeff (s, rd) result (a)
real(default), dimension(:), allocatable :: a
integer, intent(in) :: s
real(default), dimension(:), intent(in) :: rd
end function cartan_coeff
module function root_index (s, h1, h2, r) result (ai)
integer :: ai
integer, intent(in) :: s, h1, h2
logical :: r
end function root_index
module subroutine root_helicity (s, i, h1, h2, r)
integer, intent(in) :: s, i
integer, intent(out) :: h1, h2
logical, intent(out) :: r
end subroutine root_helicity
end interface
end module su_algebra
submodule (su_algebra) su_algebra_s
use physics_defs, only: SCALAR, SPINOR, VECTOR, VECTORSPINOR, TENSOR
implicit none
contains
module function algebra_dimension (s) result (n)
integer :: n
integer, intent(in) :: s
n = fundamental_dimension (s) ** 2 - 1
end function algebra_dimension
module function fundamental_dimension (s) result (d)
integer :: d
integer, intent(in) :: s
d = s
end function fundamental_dimension
module function helicity_value (s, i) result (h)
integer :: h
integer, intent(in) :: s, i
integer, dimension(1), parameter :: hh1 = [0]
integer, dimension(2), parameter :: hh2 = [1, -1]
integer, dimension(3), parameter :: hh3 = [1, 0, -1]
integer, dimension(4), parameter :: hh4 = [2, 1, -1, -2]
integer, dimension(5), parameter :: hh5 = [2, 1, 0, -1, -2]
h = 0
select case (s)
case (SCALAR)
select case (i)
case (1:1); h = hh1(i)
end select
case (SPINOR)
select case (i)
case (1:2); h = hh2(i)
end select
case (VECTOR)
select case (i)
case (1:3); h = hh3(i)
end select
case (VECTORSPINOR)
select case (i)
case (1:4); h = hh4(i)
end select
case (TENSOR)
select case (i)
case (1:5); h = hh5(i)
end select
end select
end function helicity_value
module function helicity_index (s, h) result (i)
integer, intent(in) :: s, h
integer :: i
integer, dimension(0:0), parameter :: hi1 = [1]
integer, dimension(-1:1), parameter :: hi2 = [2, 0, 1]
integer, dimension(-1:1), parameter :: hi3 = [3, 2, 1]
integer, dimension(-2:2), parameter :: hi4 = [4, 3, 0, 2, 1]
integer, dimension(-2:2), parameter :: hi5 = [5, 4, 3, 2, 1]
select case (s)
case (SCALAR)
i = hi1(h)
case (SPINOR)
i = hi2(h)
case (VECTOR)
i = hi3(h)
case (VECTORSPINOR)
i = hi4(h)
case (TENSOR)
i = hi5(h)
end select
end function helicity_index
elemental module function is_cartan_generator (s, i) result (cartan)
logical :: cartan
integer, intent(in) :: s, i
select case (s)
case (SCALAR)
case (SPINOR)
select case (i)
case (3); cartan = .true.
case default
cartan = .false.
end select
case (VECTOR)
select case (i)
case (3,8); cartan = .true.
case default
cartan = .false.
end select
case (VECTORSPINOR)
select case (i)
case (3,6,15); cartan = .true.
case default
cartan = .false.
end select
case (TENSOR)
select case (i)
case (3,6,15,24); cartan = .true.
case default
cartan = .false.
end select
case default
cartan = .false.
end select
end function is_cartan_generator
elemental module function cartan_index (s, k) result (ci)
integer :: ci
integer, intent(in) :: s, k
integer, dimension(1), parameter :: ci2 = [3]
integer, dimension(2), parameter :: ci3 = [3,8]
integer, dimension(3), parameter :: ci4 = [3,6,15]
integer, dimension(4), parameter :: ci5 = [3,6,15,24]
select case (s)
case (SPINOR)
ci = ci2(k)
case (VECTOR)
ci = ci3(k)
case (VECTORSPINOR)
ci = ci4(k)
case (TENSOR)
ci = ci5(k)
case default
ci = 0
end select
end function cartan_index
module function cartan_element (s, h) result (a)
real(default), dimension(:), allocatable :: a
integer, intent(in) :: s, h
real(default), parameter :: sqrt2 = sqrt (2._default)
real(default), parameter :: sqrt3 = sqrt (3._default)
real(default), parameter :: sqrt10 = sqrt (10._default)
allocate (a (algebra_dimension (s)), source = 0._default)
select case (s)
case (SCALAR)
case (SPINOR)
select case (h)
case (1)
a(3) = 1._default / 2
case (-1)
a(3) = -1._default / 2
end select
case (VECTOR)
select case (h)
case (1)
a(3) = 1._default / 2
a(8) = 1._default / (2 * sqrt3)
case (-1)
a(3) = -1._default / 2
a(8) = 1._default / (2 * sqrt3)
case (0)
a(8) = -1._default / sqrt3
end select
case (VECTORSPINOR)
select case (h)
case (2)
a(3) = 1._default / 2
a(15) = 1._default / (2 * sqrt2)
case (-2)
a(3) = -1._default / 2
a(15) = 1._default / (2 * sqrt2)
case (1)
a(6) = 1._default / 2
a(15) = -1._default / (2 * sqrt2)
case (-1)
a(6) = -1._default / 2
a(15) = -1._default / (2 * sqrt2)
end select
case (TENSOR)
select case (h)
case (2)
a(3) = 1._default / 2
a(15) = 1._default / (2 * sqrt2)
a(24) = 1._default / (2 * sqrt10)
case (-2)
a(3) = -1._default / 2
a(15) = 1._default / (2 * sqrt2)
a(24) = 1._default / (2 * sqrt10)
case (1)
a(6) = 1._default / 2
a(15) = -1._default / (2 * sqrt2)
a(24) = 1._default / (2 * sqrt10)
case (-1)
a(6) = -1._default / 2
a(15) = -1._default / (2 * sqrt2)
a(24) = 1._default / (2 * sqrt10)
case (0)
a(24) = -4._default / (2 * sqrt10)
end select
end select
end function cartan_element
module function cartan_coeff (s, rd) result (a)
real(default), dimension(:), allocatable :: a
integer, intent(in) :: s
real(default), dimension(:), intent(in) :: rd
real(default), parameter :: sqrt2 = sqrt (2._default)
real(default), parameter :: sqrt3 = sqrt (3._default)
real(default), parameter :: sqrt10 = sqrt (10._default)
integer :: n
n = algebra_dimension (s)
allocate (a (n), source = 0._default)
select case (s)
case (SPINOR)
a(3) = rd(1) - rd(2)
case (VECTOR)
a(3) = rd(1) - rd(3)
a(8) = (rd(1) - 2 * rd(2) + rd(3)) / sqrt3
case (VECTORSPINOR)
a(3) = rd(1) - rd(4)
a(6) = rd(2) - rd(3)
a(15) = (rd(1) - rd(2) - rd(3) + rd(4)) / sqrt2
case (TENSOR)
a(3) = rd(1) - rd(5)
a(6) = rd(2) - rd(4)
a(15) = (rd(1) - rd(2) - rd(4) + rd(5)) / sqrt2
a(24) = (rd(1) + rd(2) - 4 * rd(3) + rd(4) + rd(5)) / sqrt10
end select
end function cartan_coeff
module function root_index (s, h1, h2, r) result (ai)
integer :: ai
integer, intent(in) :: s, h1, h2
logical :: r
ai = 0
select case (s)
case (SCALAR)
case (SPINOR)
select case (h1)
case (1)
select case (h2)
case (-1); ai = 1
end select
end select
case (VECTOR)
select case (h1)
case (1)
select case (h2)
case (-1); ai = 1
case (0); ai = 4
end select
case (0)
select case (h2)
case (-1); ai = 6
end select
end select
case (VECTORSPINOR)
select case (h1)
case (2)
select case (h2)
case (-2); ai = 1
case (1); ai = 7
case (-1); ai = 11
end select
case (1)
select case (h2)
case (-1); ai = 4
case (-2); ai = 13
end select
case (-1)
select case (h2)
case (-2); ai = 9
end select
end select
case (TENSOR)
select case (h1)
case (2)
select case (h2)
case (-2); ai = 1
case (1); ai = 7
case (-1); ai = 11
case (0); ai = 16
end select
case (1)
select case (h2)
case (-1); ai = 4
case (-2); ai = 13
case (0); ai = 20
end select
case (-1)
select case (h2)
case (-2); ai = 9
end select
case (0)
select case (h2)
case (-2); ai = 18
case (-1); ai = 22
end select
end select
end select
if (ai /= 0 .and. .not. r) ai = ai + 1
end function root_index
module subroutine root_helicity (s, i, h1, h2, r)
integer, intent(in) :: s, i
integer, intent(out) :: h1, h2
logical, intent(out) :: r
h1 = 0
h2 = 0
r = .false.
select case (s)
case (SCALAR)
case (SPINOR)
select case (i)
case ( 1, 2); h1 = 1; h2 = -1; r = i == 1
end select
case (VECTOR)
select case (i)
case ( 1, 2); h1 = 1; h2 = -1; r = i == 1
case ( 4, 5); h1 = 1; h2 = 0; r = i == 4
case ( 6, 7); h1 = 0; h2 = -1; r = i == 6
end select
case (VECTORSPINOR)
select case (i)
case ( 1, 2); h1 = 2; h2 = -2; r = i == 1
case ( 4, 5); h1 = 1; h2 = -1; r = i == 4
case ( 7, 8); h1 = 2; h2 = 1; r = i == 7
case ( 9,10); h1 = -1; h2 = -2; r = i == 9
case (11,12); h1 = 2; h2 = -1; r = i ==11
case (13,14); h1 = 1; h2 = -2; r = i ==13
end select
case (TENSOR)
select case (i)
case ( 1, 2); h1 = 2; h2 = -2; r = i == 1
case ( 4, 5); h1 = 1; h2 = -1; r = i == 4
case ( 7, 8); h1 = 2; h2 = 1; r = i == 7
case ( 9,10); h1 = -1; h2 = -2; r = i == 9
case (11,12); h1 = 2; h2 = -1; r = i ==11
case (13,14); h1 = 1; h2 = -2; r = i ==13
case (16,17); h1 = 2; h2 = 0; r = i ==16
case (18,19); h1 = 0; h2 = -2; r = i ==18
case (20,21); h1 = 1; h2 = 0; r = i ==20
case (22,23); h1 = 0; h2 = -1; r = i ==22
end select
end select
end subroutine root_helicity
end submodule su_algebra_s
module bloch_vectors
use kinds, only: default
use physics_defs, only: UNKNOWN
implicit none
private
public :: bloch_vector_t
type :: bloch_vector_t
private
integer :: spin_type = UNKNOWN
real(default), dimension(:), allocatable :: a
contains
generic :: init => bloch_vector_init
procedure, private :: bloch_vector_init
procedure :: from_array => bloch_vector_from_array
procedure :: to_array => bloch_vector_to_array
procedure :: hel_value => bv_helicity_value
procedure :: bloch_factor => bv_factor
procedure :: is_defined => bloch_vector_is_defined
procedure :: is_polarized => bloch_vector_is_polarized
procedure :: is_diagonal => bloch_vector_is_diagonal
procedure :: get_norm => bloch_vector_get_norm
generic :: init => bloch_vector_init_diagonal
procedure, private :: bloch_vector_init_diagonal
generic :: set => bloch_vector_set_diagonal
procedure, private :: bloch_vector_set_diagonal
procedure :: to_vector => bloch_vector_to_vector
generic :: init => bloch_vector_init_matrix
procedure, private :: bloch_vector_init_matrix
generic :: set => bloch_vector_set_matrix
procedure, private :: bloch_vector_set_matrix
procedure :: to_matrix => bloch_vector_to_matrix
end type bloch_vector_t
interface
module subroutine bloch_vector_init (pol, spin_type)
class(bloch_vector_t), intent(out) :: pol
integer, intent(in) :: spin_type
end subroutine bloch_vector_init
module subroutine bloch_vector_from_array (pol, a)
class(bloch_vector_t), intent(inout) :: pol
real(default), dimension(:), allocatable, intent(in) :: a
end subroutine bloch_vector_from_array
module subroutine bloch_vector_to_array (pol, a)
class(bloch_vector_t), intent(in) :: pol
real(default), dimension(:), allocatable, intent(out) :: a
end subroutine bloch_vector_to_array
module function bv_helicity_value (pol, i) result (h)
class(bloch_vector_t), intent(in) :: pol
integer, intent(in) :: i
integer :: h
end function bv_helicity_value
module function bv_factor (pol) result (f)
class(bloch_vector_t), intent(in) :: pol
real(default) :: f
end function bv_factor
module function bloch_vector_is_defined (pol) result (flag)
class(bloch_vector_t), intent(in) :: pol
logical :: flag
end function bloch_vector_is_defined
module function bloch_vector_is_polarized (pol) result (flag)
class(bloch_vector_t), intent(in) :: pol
logical :: flag
end function bloch_vector_is_polarized
module function bloch_vector_is_diagonal (pol) result (diagonal)
class(bloch_vector_t), intent(in) :: pol
logical :: diagonal
end function bloch_vector_is_diagonal
module function bloch_vector_get_norm (pol) result (norm)
class(bloch_vector_t), intent(in) :: pol
real(default) :: norm
end function bloch_vector_get_norm
module subroutine bloch_vector_init_diagonal (pol, spin_type, rd)
class(bloch_vector_t), intent(out) :: pol
integer, intent(in) :: spin_type
real(default), dimension(:), intent(in) :: rd
end subroutine bloch_vector_init_diagonal
module subroutine bloch_vector_set_diagonal (pol, rd)
class(bloch_vector_t), intent(inout) :: pol
real(default), dimension(:), intent(in) :: rd
end subroutine bloch_vector_set_diagonal
module subroutine bloch_vector_to_vector (pol, a)
class(bloch_vector_t), intent(in) :: pol
real(default), dimension(3), intent(out) :: a
end subroutine bloch_vector_to_vector
module subroutine bloch_vector_init_matrix (pol, spin_type, r)
class(bloch_vector_t), intent(out) :: pol
integer, intent(in) :: spin_type
complex(default), dimension(:,:), intent(in) :: r
end subroutine bloch_vector_init_matrix
module subroutine bloch_vector_set_matrix (pol, r)
class(bloch_vector_t), intent(inout) :: pol
complex(default), dimension(:,:), intent(in) :: r
end subroutine bloch_vector_set_matrix
module subroutine bloch_vector_to_matrix (pol, r, only_max_weight)
class(bloch_vector_t), intent(in) :: pol
complex(default), dimension(:,:), intent(out), allocatable :: r
logical, intent(in), optional :: only_max_weight
end subroutine bloch_vector_to_matrix
end interface
end module bloch_vectors
submodule (bloch_vectors) bloch_vectors_s
use physics_defs, only: SCALAR, SPINOR, VECTOR, VECTORSPINOR, TENSOR
use su_algebra
implicit none
contains
function bloch_factor (s) result (f)
real(default) :: f
integer, intent(in) :: s
select case (s)
case (SCALAR)
f = 0
case (SPINOR)
f = 1
case (VECTOR)
f = 2 * sqrt (3._default) / 3
case (VECTORSPINOR)
f = 2 * sqrt (6._default) / 4
case (TENSOR)
f = 2 * sqrt (10._default) / 5
case default
f = 0
end select
end function bloch_factor
module subroutine bloch_vector_init (pol, spin_type)
class(bloch_vector_t), intent(out) :: pol
integer, intent(in) :: spin_type
pol%spin_type = spin_type
select case (spin_type)
case (SCALAR,SPINOR,VECTOR,VECTORSPINOR,TENSOR)
allocate (pol%a (algebra_dimension (spin_type)), source = 0._default)
end select
end subroutine bloch_vector_init
module subroutine bloch_vector_from_array (pol, a)
class(bloch_vector_t), intent(inout) :: pol
real(default), dimension(:), allocatable, intent(in) :: a
pol%a(:) = a
end subroutine bloch_vector_from_array
module subroutine bloch_vector_to_array (pol, a)
class(bloch_vector_t), intent(in) :: pol
real(default), dimension(:), allocatable, intent(out) :: a
if (pol%is_defined ()) allocate (a (size (pol%a)), source = pol%a)
end subroutine bloch_vector_to_array
module function bv_helicity_value (pol, i) result (h)
class(bloch_vector_t), intent(in) :: pol
integer, intent(in) :: i
integer :: h
h = helicity_value (pol%spin_type, i)
end function bv_helicity_value
module function bv_factor (pol) result (f)
class(bloch_vector_t), intent(in) :: pol
real(default) :: f
f = bloch_factor (pol%spin_type)
end function bv_factor
module function bloch_vector_is_defined (pol) result (flag)
class(bloch_vector_t), intent(in) :: pol
logical :: flag
flag = pol%spin_type /= UNKNOWN
end function bloch_vector_is_defined
module function bloch_vector_is_polarized (pol) result (flag)
class(bloch_vector_t), intent(in) :: pol
logical :: flag
flag = allocated (pol%a)
end function bloch_vector_is_polarized
module function bloch_vector_is_diagonal (pol) result (diagonal)
class(bloch_vector_t), intent(in) :: pol
logical :: diagonal
integer :: s, i
s = pol%spin_type
diagonal = .true.
if (pol%is_polarized ()) then
do i = 1, size (pol%a)
if (is_cartan_generator (s, i)) cycle
if (pol%a(i) /= 0) then
diagonal = .false.
return
end if
end do
end if
end function bloch_vector_is_diagonal
module function bloch_vector_get_norm (pol) result (norm)
class(bloch_vector_t), intent(in) :: pol
real(default) :: norm
select case (pol%spin_type)
case (SPINOR,VECTOR,VECTORSPINOR,TENSOR)
norm = sqrt (dot_product (pol%a, pol%a))
case default
norm = 1
end select
end function bloch_vector_get_norm
module subroutine bloch_vector_init_diagonal (pol, spin_type, rd)
class(bloch_vector_t), intent(out) :: pol
integer, intent(in) :: spin_type
real(default), dimension(:), intent(in) :: rd
call pol%init (spin_type)
call pol%set (rd)
end subroutine bloch_vector_init_diagonal
module subroutine bloch_vector_set_diagonal (pol, rd)
class(bloch_vector_t), intent(inout) :: pol
real(default), dimension(:), intent(in) :: rd
integer :: s
s = pol%spin_type
select case (s)
case (SCALAR,SPINOR,VECTOR,VECTORSPINOR,TENSOR)
pol%a(:) = cartan_coeff (s, rd) / bloch_factor (s)
end select
end subroutine bloch_vector_set_diagonal
module subroutine bloch_vector_to_vector (pol, a)
class(bloch_vector_t), intent(in) :: pol
real(default), dimension(3), intent(out) :: a
integer :: s
s = pol%spin_type
select case (s)
case (SPINOR, VECTOR, VECTORSPINOR, TENSOR)
a = pol%a(1:3) * bloch_factor (s)
case default
a = 0
end select
end subroutine bloch_vector_to_vector
module subroutine bloch_vector_init_matrix (pol, spin_type, r)
class(bloch_vector_t), intent(out) :: pol
integer, intent(in) :: spin_type
complex(default), dimension(:,:), intent(in) :: r
select case (spin_type)
case (SCALAR,SPINOR,VECTOR,VECTORSPINOR,TENSOR)
call pol%init (spin_type)
call pol%set (r)
case default
call pol%init (UNKNOWN)
end select
end subroutine bloch_vector_init_matrix
module subroutine bloch_vector_set_matrix (pol, r)
class(bloch_vector_t), intent(inout) :: pol
complex(default), dimension(:,:), intent(in) :: r
real(default), dimension(:), allocatable :: rd
integer :: s, d, i, j, h1, h2, ir, ii
s = pol%spin_type
select case (s)
case (SCALAR,SPINOR,VECTOR,VECTORSPINOR,TENSOR)
d = fundamental_dimension (s)
allocate (rd (d))
do i = 1, d
rd(i) = r(i,i)
end do
call pol%set (rd)
do i = 1, d
h1 = helicity_value (s, i)
do j = i+1, d
h2 = helicity_value (s, j)
ir = root_index (s, h1, h2, .true.)
ii = root_index (s, h1, h2, .false.)
pol%a(ir) = real (r(j,i) + r(i,j)) / bloch_factor (s)
pol%a(ii) = aimag (r(j,i) - r(i,j)) / bloch_factor (s)
end do
end do
end select
end subroutine bloch_vector_set_matrix
module subroutine bloch_vector_to_matrix (pol, r, only_max_weight)
class(bloch_vector_t), intent(in) :: pol
complex(default), dimension(:,:), intent(out), allocatable :: r
logical, intent(in), optional :: only_max_weight
integer :: d, s, h0, ng, ai, h, h1, h2, i, j
logical :: is_real, only_max
complex(default) :: val
if (.not. pol%is_polarized ()) return
s = pol%spin_type
only_max = .false.
select case (s)
case (VECTOR, VECTORSPINOR, TENSOR)
if (present (only_max_weight)) only_max = only_max_weight
end select
if (only_max) then
ng = 2
h0 = helicity_value (s, 1)
else
ng = algebra_dimension (s)
h0 = 0
end if
d = fundamental_dimension (s)
allocate (r (d, d), source = (0._default, 0._default))
do i = 1, d
h = helicity_value (s, i)
if (abs (h) < h0) cycle
r(i,i) = 1._default / d &
+ dot_product (cartan_element (s, h), pol%a) * bloch_factor (s)
end do
do ai = 1, ng
if (is_cartan_generator (s, ai)) cycle
call root_helicity (s, ai, h1, h2, is_real)
i = helicity_index (s, h1)
j = helicity_index (s, h2)
if (is_real) then
val = cmplx (pol%a(ai) / 2 * bloch_factor (s), 0._default, &
kind=default)
r(i,j) = r(i,j) + val
r(j,i) = r(j,i) + val
else
val = cmplx (0._default, pol%a(ai) / 2 * bloch_factor (s), &
kind=default)
r(i,j) = r(i,j) - val
r(j,i) = r(j,i) + val
end if
end do
end subroutine bloch_vector_to_matrix
end submodule bloch_vectors_s
module bloch_vectors_uti
use kinds, only: default
use physics_defs, only: UNKNOWN, SCALAR, SPINOR, VECTOR, VECTORSPINOR, TENSOR
use su_algebra, only: algebra_dimension, fundamental_dimension, helicity_value
use bloch_vectors
implicit none
private
public :: bloch_vectors_3
contains
subroutine bloch_vectors_3 (u)
integer, intent(in) :: u
write (u, "(A)") "* Test output: bloch_vectors_3"
write (u, "(A)") "* Purpose: test Bloch-vector &
&polarization implementation"
write (u, "(A)")
write (u, "(A)") "* Initialization (pure polarized, arbitrary):"
write (u, "(A)") "* input matrix, transform, display norm, transform back"
write (u, "(A)")
write (u, "(A)") "* s = 0"
call bloch_arbitrary (SCALAR)
write (u, "(A)")
write (u, "(A)") "* s = 1/2"
call bloch_arbitrary (SPINOR)
write (u, "(A)")
write (u, "(A)") "* s = 1"
call bloch_arbitrary (VECTOR)
write (u, "(A)")
write (u, "(A)") "* s = 3/2"
call bloch_arbitrary (VECTORSPINOR)
write (u, "(A)")
write (u, "(A)") "* s = 2"
call bloch_arbitrary (TENSOR)
write (u, "(A)")
write (u, "(A)") "* Test output end: bloch_vectors_3"
contains
subroutine bloch_arbitrary (s)
integer, intent(in) :: s
type(bloch_vector_t) :: pol
complex(default), dimension(:,:), allocatable :: r
integer :: d
d = fundamental_dimension (s)
write (u, *)
call init_matrix (d, r)
where (abs (aimag (r)) < 1.e-14_default) &
r = cmplx (real(r, kind=default), 0._default, kind=default)
call write_matrix (d, r)
call pol%init (s, r)
write (u, *)
write (u, 2) pol%get_norm (), pol%is_diagonal ()
write (u, *)
call pol%to_matrix (r)
call write_matrix (d, r)
2 format (1X,F7.4,1X,L1)
end subroutine bloch_arbitrary
subroutine init_matrix (d, r)
integer, intent(in) :: d
complex(default), dimension(:,:), allocatable, intent(out) :: r
complex(default), dimension(:), allocatable :: a
real(default) :: norm
integer :: i, j
allocate (a (d))
norm = 0
do i = 1, d
a(i) = cmplx (2*i-1, 2*i, kind=default)
norm = norm + conjg (a(i)) * a(i)
end do
a = a / sqrt (norm)
allocate (r (d,d))
do i = 1, d
do j = 1, d
r(i,j) = conjg (a(i)) * a(j)
end do
end do
end subroutine init_matrix
subroutine write_matrix (d, r)
integer, intent(in) :: d
complex(default), dimension(:,:), intent(in) :: r
integer :: i, j
do i = 1, d
do j = 1, d
write (u, 1, advance="no") r(i,j)
end do
write (u, *)
end do
1 format (99(1X,'(',F7.4,',',F7.4,')',:))
end subroutine write_matrix
end subroutine bloch_vectors_3
end module bloch_vectors_uti
program main_ut
use bloch_vectors_uti, only: bloch_vectors_3
implicit none
call bloch_vectors_3 (11)
end program main_utLink Copied
10 Replies
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
By the way, interestingly, this unit test from our code also behaves differently for the ifx 2024.2 compiler from the "classical" ifort as of 2023, Nagfor 7, and gfortran compilers. I still need to understand the details. Shall I submit a separate report on the ifx issue?
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
the testcase above is a compiler bug, a regression at that as it first appears in the 2024.2 compiler. I have done rudimentary triage but have yet to isolate it further. We did some work on submodules which may be at the root cause but until I am sure, this is just a theory.
For the unit test: "behaves differently" do you mean the results are different? at -O0 or at optimization? can you explain more about what you see with the ifx unit test?
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
For ifx with -O0, the produced code segfaults, for -O2 it gives a "wrong" result, different than the expected. I will upload a reproducer. The files in ref-output are the expected outputs, the files in err-output are the two tests #3 and #6 that give different results with -O2
(but do not segfault).
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
And here is the backtrace for this segmentation fault (note again, that this is for ifx now, not ifort):
Program received signal SIGSEGV, Segmentation fault.
bloch_vectors_3::bloch_arbitrary (s=1) at main_ut.f90:4001
4001 r = cmplx (real(r, kind=default), 0._default, kind=default)
Missing separate debuginfos, use: dnf debuginfo-install libgcc-11.4.1-3.el9.alma.1.x86_64
(gdb) bt
#0 bloch_vectors_3::bloch_arbitrary (s=1) at main_ut.f90:4001
#1 0x0000000000423917 in bloch_vectors_uti::bloch_vectors_3 (u=12) at main_ut.f90:3969
#2 0x000000000041983f in unit_tests@unit_tests_s::test (test_proc=0xb0ec8148e5894855, name=..., description=..., u_log=11, results=..., _name=15, _description=22)
at main_ut.f90:2825
#3 0x000000000042b75a in bloch_vectors_ut::bloch_vectors_test (u=11, results=...) at main_ut.f90:4379
#4 0x000000000042b9f9 in main_ut::whizard_check (results=...) at main_ut.f90:4420
#5 0x000000000042b869 in main_ut () at main_ut.f90:4410
#6 0x00000000004051ad in main ()
#7 0x00007ffff7829590 in __libc_start_call_main (main=main@entry=0x405190 <main>, argc=argc@entry=1, argv=argv@entry=0x7fffffffd418)
at ../sysdeps/nptl/libc_start_call_main.h:58
#8 0x00007ffff7829640 in __libc_start_main_impl (main=0x405190 <main>, argc=1, argv=0x7fffffffd418, init=<optimized out>, fini=<optimized out>, rtld_fini=<optimized out>,
stack_end=0x7fffffffd408) at ../csu/libc-start.c:389
#9 0x00000000004050c5 in _start ()- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Here is a bit shorter reproducer with just the single unit test that segfaults (with -O0) and gives a wrong result (with -O2).
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I isolated this down to an assignment whose right-hand side expression contains the combo of CMPLX( REAL( ...), ...)
Bug ID is CMPLRLLVM-59852
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
back to the original reproducer, here is a reduced example. the seg fault is on the assignement
r = cmplx (real(r, kind=8), 0.0_8) !...this assignment seg faults
module bloch_vectors_uti
contains
subroutine bloch_vectors_3 ()
call bloch_arbitrary ()
contains
subroutine bloch_arbitrary ()
complex(8), dimension(:,:), allocatable :: r
allocate ( r(1,1) )
r = cmplx (real(r, kind=8), 0.0_8) !...this assignment seg faults
end subroutine bloch_arbitrary
end subroutine bloch_vectors_3
end module bloch_vectors_uti
program main_ut
use bloch_vectors_uti
implicit none
print*, "starting"
call bloch_vectors_3 ()
print*, "ending"
end program main_ut- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
regarding the 2 later cases, I can see the failures. However, both .f90 files contain the same construct
r = cmplx (real(r, kind=default), 0._default, kind=default)
R is type complex, allocatable, rank 2. In the first test case it assumes sizes
(1,1), (2,2), (3,3), etc. Same in these examples?
unwinding the assignment statement: is it your intent to keep the real part of elements in r and set the imaginary parts of r to 0.0?
In any case, this looks 'same as' the original case and my reduced reproducer. So I'll wait to open a new issue we get resolution to the first and reduced case. Then I can retest the subsequent cases. I fully expect they will work once the reproducers are resolved.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Ron, great, thanks for the swift action. Just to make sure: you took care of both issues here (the one for the ifort and the one for ifx), right? I'm not sure it is really the same issue, but at least both stumble over our unit test bloch_vectors_3. That bloch_vectors_6 gets executed correctly by ifort and incorrectly by ifx might be accidental. Let me know if there is anything I can or need to do.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
@Juergen_R_R we had a fix go into the code branch for the 2025.0 release ( November/December).
It checked out with both my test code and your main_ut.f90 at -O0 and -O2. Note that I did not have to use -fp-model precise
ifx -what -V -O2 -xhost main_ut.f90
Intel(R) Fortran Compiler for applications running on Intel(R) 64, Version dev.x.0 Mainline Build 20240717
Copyright (C) 1985-2024 Intel Corporation. All rights reserved.
Intel(R) Fortran 25.0-1144
GNU ld version 2.41-34.fc40
rwgreen@orcsle153:~/quad/q06277330/test2$ ./a.out
Running test: bloch_vectors_1 ... success.
Running test: bloch_vectors_2 ... success.
Running test: bloch_vectors_3 ... success.
Running test: bloch_vectors_4 ... success.
Running test: bloch_vectors_5 ... success.
Running test: bloch_vectors_6 ... success.
Running test: bloch_vectors_7 ... success.
*** Test Summary ***
Success:
bloch_vectors_1: initialization
bloch_vectors_2: pure state (diagonal)
bloch_vectors_3: pure state (arbitrary)
bloch_vectors_4: raw I/O
bloch_vectors_5: massless state (unpolarized)
bloch_vectors_6: massless state (arbitrary)
bloch_vectors_7: massless state (vector)
Total = 7
Success = 7
Failure = 0
*** End of test Summary ***
and at O2 with xhost
ifx -g -O2 -xhost main_ut.f90
rwgreen@orcsle153:~/quad/q06277330/test2$ ./a.out
Running test: bloch_vectors_1 ... success.
Running test: bloch_vectors_2 ... success.
Running test: bloch_vectors_3 ... success.
Running test: bloch_vectors_4 ... success.
Running test: bloch_vectors_5 ... success.
Running test: bloch_vectors_6 ... success.
Running test: bloch_vectors_7 ... success.
*** Test Summary ***
Success:
bloch_vectors_1: initialization
bloch_vectors_2: pure state (diagonal)
bloch_vectors_3: pure state (arbitrary)
bloch_vectors_4: raw I/O
bloch_vectors_5: massless state (unpolarized)
bloch_vectors_6: massless state (arbitrary)
bloch_vectors_7: massless state (vector)
Total = 7
Success = 7
Failure = 0
*** End of test Summary ***
and my 'invptr.f90' testcase
$ rm -rf a.out ; ifx -O0 -g -traceback invptr.f90 -what -V -stand f23 ; ./a.out
Intel(R) Fortran Compiler for applications running on Intel(R) 64, Version dev.x.0 Mainline Build 20240717
Copyright (C) 1985-2024 Intel Corporation. All rights reserved.
Intel(R) Fortran 25.0-1144
GNU ld version 2.41-34.fc40
starting
ending
Reply
Topic Options
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page