Ifx produces code that segfaults

[Juergen_R_R]

The following code compiles and produces working code with Intel OneApi 21.10, gfortran, nagfor, but ifx produces a binaru from the code that segfaults:

[Thread debugging using libthread_db enabled]
Using host libthread_db library "/lib/x86_64-linux-gnu/libthread_db.so.1".

Program received signal SIGSEGV, Segmentation fault.
0x00000000004065db in particles_mp_particle_set_set_momentum_all_ ()
(gdb) bt
#0 0x00000000004065db in particles_mp_particle_set_set_momentum_all_ ()
#1 0x00000000004077f2 in main_ut_IP_eio_direct_1_ ()
#2 0x000000000040515d in main ()
#3 0x00007ffff789bd90 in __libc_start_call_main (main=main@entry=0x405140 <main>, argc=argc@entry=1, argv=argv@entry=0x7fffffffc408)
at ../sysdeps/nptl/libc_start_call_main.h:58
#4 0x00007ffff789be40 in __libc_start_main_impl (main=0x405140 <main>, argc=1, argv=0x7fffffffc408, init=<optimized out>, fini=<optimized out>,
rtld_fini=<optimized out>, stack_end=0x7fffffffc3f8) at ../csu/libc-start.c:392
#5 0x0000000000405075 in _start ()

module model_data
  use, intrinsic :: iso_c_binding !NODEP!
  implicit none
  private
  public :: field_data_t
  public :: model_data_t

  type :: field_data_t
     private
     character(6) :: longname
     integer :: pdg = 0
     character(2), dimension(:), allocatable :: name
   contains
     procedure :: init => field_data_init
     procedure :: set => field_data_set
  end type field_data_t

  type :: model_data_t
     private
     character(4) :: name
     type(field_data_t), dimension(:), allocatable :: field
   contains
     generic :: init => model_data_init
     procedure, private :: model_data_init
     procedure :: get_field_ptr_by_index => model_data_get_field_ptr_index
     procedure :: init_test => model_data_init_test
  end type model_data_t

contains

  subroutine field_data_init (prt, longname, pdg)
    class(field_data_t), intent(out) :: prt
    character(6), intent(in) :: longname
    integer, intent(in) :: pdg
    prt%longname = longname
    prt%pdg = pdg
  end subroutine field_data_init

  subroutine field_data_set (prt, name)
    class(field_data_t), intent(inout) :: prt
    character(2), dimension(:), intent(in), optional :: name
    if (present (name)) then
       prt%name = name
    end if
  end subroutine field_data_set

  subroutine model_data_init (model, name, &
       n_par_real, n_field, n_vtx)
    class(model_data_t), intent(out) :: model
    character(4), intent(in) :: name
    integer, intent(in) :: n_par_real
    integer, intent(in) :: n_field
    integer, intent(in) :: n_vtx
    model%name = name
    allocate (model%field (n_field))
  end subroutine model_data_init

  function model_data_get_field_ptr_index (model, i) result (ptr)
    class(model_data_t), intent(in), target :: model
    integer, intent(in) :: i
    type(field_data_t), pointer :: ptr
    ptr => model%field(i)
  end function model_data_get_field_ptr_index

  subroutine model_data_init_test (model)
    class(model_data_t), intent(out) :: model
    type(field_data_t), pointer :: field
    integer, parameter :: n_real = 4
    integer, parameter :: n_field = 2
    integer, parameter :: n_vertex = 0
    ! real, pointer :: ms, mf
    integer :: i
    call model%init ("Test", &
         n_real, n_field, n_vertex)
    i = 0
    i = i + 1
    field => model%get_field_ptr_by_index (i)
    call field%init ("SCALAR", 25)
    call field%set (name = ["ss"])
    i = i + 1
    field => model%get_field_ptr_by_index (i)
    call field%init ("FERMION", 6)
    call field%set (name = ["ff"])
  end subroutine model_data_init_test

  
end module model_data



module lorentz
  implicit none
  private

  public :: vector4_t
  public :: vector4_null
  public :: assignment (=)
  public :: vector4
  public :: operator(*)
  public :: operator(**)

  type :: vector4_t
     real, dimension(0:3) :: p = &
        [0, 0, 0, 0]
  end type vector4_t

  type(vector4_t), parameter :: vector4_null = &
       vector4_t ([ 0, 0, 0, 0 ])

  interface operator(*)
     module procedure prod_real_vector4, prod_vector4_real
     module procedure prod_integer_vector4, prod_vector4_integer
  end interface
  interface operator(*)
     module procedure prod_vector4
  end interface
  interface operator(**)
     module procedure power_vector4
  end interface
  interface assignment (=)
     module procedure vector4_from_array
  end interface

contains

  elemental function prod_real_vector4 (s, p) result (q)
    type(vector4_t) :: q
    real, intent(in) :: s
    type(vector4_t), intent(in) :: p
    q%p = s * p%p
  end function prod_real_vector4
  elemental function prod_vector4_real (p, s) result (q)
    type(vector4_t) :: q
    real, intent(in) :: s
    type(vector4_t), intent(in) :: p
    q%p = s * p%p
  end function prod_vector4_real
  elemental function prod_integer_vector4 (s, p) result (q)
    type(vector4_t) :: q
    integer, intent(in) :: s
    type(vector4_t), intent(in) :: p
    q%p = s * p%p
  end function prod_integer_vector4
  elemental function prod_vector4_integer (p, s) result (q)
    type(vector4_t) :: q
    integer, intent(in) :: s
    type(vector4_t), intent(in) :: p
    q%p = s * p%p
  end function prod_vector4_integer

  elemental function prod_vector4 (p, q) result (s)
    real :: s
    type(vector4_t), intent(in) :: p,q
    s = p%p(0)*q%p(0) - dot_product(p%p(1:), q%p(1:))
  end function prod_vector4

  elemental function power_vector4 (p, e) result (s)
    real :: s
    type(vector4_t), intent(in) :: p
    integer, intent(in) :: e
    s = p * p
    if (e /= 2) then
       if (mod(e, 2) == 0) then
          s = s**(e / 2)
       else if (s >= 0) then
          s = sqrt(s)**e
       else
          s = -(sqrt(abs(s))**e)
       end if
    end if
  end function power_vector4

  pure subroutine vector4_from_array (p, a)
    type(vector4_t), intent(out) :: p
    real, dimension(:), intent(in) :: a
    p%p(0:3) = a
  end subroutine vector4_from_array

  pure function vector4 (a) result (p)
    type(vector4_t) :: p
    real, intent(in), dimension(4) :: a
    p%p = a
  end function vector4
  
end module lorentz



module flavors
  use model_data
  implicit none
  private
  public :: flavor_t

  type :: flavor_t
     private
     integer :: f = 0
     type(field_data_t), pointer :: field_data => null ()
   contains
     generic :: init => &
          flavor_init_model
     procedure, private :: flavor_init_model
     procedure :: is_associated => flavor_is_associated
  end type flavor_t


contains

  impure elemental subroutine flavor_init_model (flv, f, model)
    class(flavor_t), intent(inout) :: flv
    integer, intent(in) :: f
    class(model_data_t), intent(in), target :: model
    flv%f = f
  end subroutine flavor_init_model

  elemental function flavor_is_associated (flv) result (flag)
    class(flavor_t), intent(in) :: flv
    logical :: flag
    flag = associated (flv%field_data)
  end function flavor_is_associated

end module flavors


module particles
  use lorentz
  use model_data
  use flavors

  implicit none
  private

  public :: particle_t
  public :: particle_set_t
  
  type :: particle_t
     !private
     integer :: status = 0
     type(flavor_t) :: flv
     type(vector4_t) :: p = vector4_null
     real :: p2 = 0
     real, allocatable :: lifetime
     integer, dimension(:), allocatable :: parent
     integer, dimension(:), allocatable :: child
   contains
    procedure :: final => particle_final
    procedure :: set_flavor => particle_set_flavor
    procedure :: set_momentum => particle_set_momentum
  end type particle_t

  type :: particle_set_t
     ! private !!!
     integer :: n_beam = 0
     integer :: n_in  = 0
     integer :: n_vir = 0
     integer :: n_out = 0
     integer :: n_tot = 0
     integer :: factorization_mode = 0
     type(particle_t), dimension(:), allocatable :: prt
   contains
     procedure :: final => particle_set_final
     procedure :: basic_init => particle_set_basic_init
     procedure :: init_direct => particle_set_init_direct
     generic :: set_momentum => set_momentum_single
     generic :: set_momentum => set_momentum_all
     procedure :: set_momentum_single => particle_set_set_momentum_single
     procedure :: set_momentum_all => particle_set_set_momentum_all
  end type particle_set_t


contains

  subroutine particle_final (prt)
    class(particle_t), intent(inout) :: prt
    if (allocated (prt%lifetime))  deallocate (prt%lifetime)
  end subroutine particle_final

  subroutine particle_set_flavor (prt, flv)
    class(particle_t), intent(inout) :: prt
    type(flavor_t), intent(in) :: flv
    prt%flv = flv
  end subroutine particle_set_flavor

  elemental subroutine particle_set_momentum (prt, p, p2, on_shell)
    class(particle_t), intent(inout) :: prt
    type(vector4_t), intent(in) :: p
    real, intent(in), optional :: p2
    logical, intent(in), optional :: on_shell
    prt%p = p
    if (present (on_shell)) then
       if (on_shell) then
          if (prt%flv%is_associated ()) then
             prt%p2 = 125.**2
             return
          end if
       end if
    end if
    if (present (p2)) then
       prt%p2 = p2
    else
       prt%p2 = p ** 2
    end if
  end subroutine particle_set_momentum

  subroutine particle_set_final (particle_set)
    class(particle_set_t), intent(inout) :: particle_set
    integer :: i
    if (allocated (particle_set%prt)) then
       do i = 1, size(particle_set%prt)
          call particle_set%prt(i)%final ()
       end do
       deallocate (particle_set%prt)
    end if
  end subroutine particle_set_final

  subroutine particle_set_basic_init (particle_set, n_beam, n_in, n_vir, n_out)
    class(particle_set_t), intent(out) :: particle_set
    integer, intent(in) :: n_beam, n_in, n_vir, n_out
    particle_set%n_beam = n_beam
    particle_set%n_in = n_in
    particle_set%n_vir = n_vir
    particle_set%n_out = n_out
    particle_set%n_tot = n_beam + n_in + n_vir + n_out
    allocate (particle_set%prt (particle_set%n_tot))
  end subroutine particle_set_basic_init

  subroutine particle_set_init_direct (particle_set, &
       n_beam, n_in, n_rem, n_vir, n_out, pdg, model)
    class(particle_set_t), intent(out) :: particle_set
    integer, intent(in) :: n_beam
    integer, intent(in) :: n_in
    integer, intent(in) :: n_rem
    integer, intent(in) :: n_vir
    integer, intent(in) :: n_out
    integer, dimension(:), intent(in) :: pdg
    class(model_data_t), intent(in), target :: model
    type(flavor_t), dimension(:), allocatable :: flv
    integer :: i, k, n
    call particle_set%basic_init (n_beam, n_in, n_rem+n_vir, n_out)
    n = 0
    n = n + n_beam
    n = n + n_in
    n = n + n_rem
    n = n + n_vir
    allocate (flv (particle_set%n_tot))
    call flv%init (pdg, model)
    do i = 1, particle_set%n_tot
       call particle_set%prt(i)%set_flavor (flv(i))
    end do
  end subroutine particle_set_init_direct

  subroutine particle_set_set_momentum_single &
       (particle_set, i, p, p2, on_shell)
    class(particle_set_t), intent(inout) :: particle_set
    integer, intent(in) :: i
    type(vector4_t), intent(in) :: p
    real, intent(in), optional :: p2
    logical, intent(in), optional :: on_shell
    call particle_set%prt(i)%set_momentum (p, p2, on_shell)
  end subroutine particle_set_set_momentum_single

  subroutine particle_set_set_momentum_all (particle_set, p, p2, on_shell)
    class(particle_set_t), intent(inout) :: particle_set
    type(vector4_t), dimension(:), intent(in) :: p
    real, dimension(:), intent(in), optional :: p2
    logical, intent(in), optional :: on_shell
    call particle_set%prt%set_momentum (p, p2, on_shell)
  end subroutine particle_set_set_momentum_all
  
end module particles


module eio_direct
  use lorentz
  use particles, only: particle_set_t
  use model_data, only: model_data_t
  implicit none
  private
  public :: eio_direct_t

  type :: eio_direct_t
     private
     type(particle_set_t) :: pset
   contains
     procedure :: final => eio_direct_final
     procedure :: init_direct => eio_direct_init_direct
     generic :: set_momentum => set_momentum_single
     generic :: set_momentum => set_momentum_all
     procedure :: set_momentum_single => eio_direct_set_momentum_single
     procedure :: set_momentum_all => eio_direct_set_momentum_all
  end type eio_direct_t


contains

  subroutine eio_direct_final (object)
    class(eio_direct_t), intent(inout) :: object
    call object%pset%final ()
  end subroutine eio_direct_final

  subroutine eio_direct_init_direct &
       (eio, n_beam, n_in, n_rem, n_vir, n_out, pdg, model)
    class(eio_direct_t), intent(out) :: eio
    integer, intent(in) :: n_beam
    integer, intent(in) :: n_in
    integer, intent(in) :: n_rem
    integer, intent(in) :: n_vir
    integer, intent(in) :: n_out
    integer, dimension(:), intent(in) :: pdg
    class(model_data_t), intent(in), target :: model
    call eio%pset%init_direct (n_beam, n_in, n_rem, n_vir, n_out, pdg, model)
  end subroutine eio_direct_init_direct

  subroutine eio_direct_set_momentum_single (eio, i, p, p2, on_shell)
    class(eio_direct_t), intent(inout) :: eio
    integer, intent(in) :: i
    type(vector4_t), intent(in) :: p
    real, intent(in), optional :: p2
    logical, intent(in), optional :: on_shell
    call eio%pset%set_momentum (i, p, p2, on_shell)
 end subroutine eio_direct_set_momentum_single

  subroutine eio_direct_set_momentum_all (eio, p, p2, on_shell)
    class(eio_direct_t), intent(inout) :: eio
    type(vector4_t), dimension(:), intent(in) :: p
    real, dimension(:), intent(in), optional :: p2
    logical, intent(in), optional :: on_shell
    call eio%pset%set_momentum (p, p2, on_shell)
  end subroutine eio_direct_set_momentum_all
end module eio_direct

program main_ut
  use lorentz, only: vector4_t
  use model_data, only: model_data_t
  use eio_direct
  implicit none
  
  call eio_direct_1 (6)

contains

  subroutine eio_direct_1 (u)
    integer, intent(in) :: u
    type(eio_direct_t) :: eio
    type(vector4_t), dimension(:), allocatable :: p
    class(model_data_t), pointer :: model
    allocate (model)
    call model%init_test ()
    allocate (p(4))
    p(1)%p = [ 500., 0., 0., sqrt(500.**2 - 125.**2)]
    p(2)%p = [ 500., 0., 0., -sqrt(500.**2 - 125.**2)]
    p(3)%p = [ 500., -149.6022091137, -460.4282561141,  0.]
    p(4)%p = [ 500., 149.6022091137, 460.4282561141,  0.]
    call eio%final ()
    call eio%init_direct ( &
         n_beam = 0, n_in = 2, n_rem = 0, n_vir = 0, n_out = 2, &
         pdg = [25, 25, 25, 25], model = model)
    call eio%set_momentum (p([1,2,4,3]), on_shell=.true.)
  end subroutine eio_direct_1
  
end program main_ut

[Juergen_R_R]

ifx v2024.0.0

[Ron_Green]

Thank you for sending this to us. I will create a bug report.

[Ron_Green]

bug ID is CMPLRLLVM-54624

[Juergen_R_R]

Is there any progress on this issue? Here is a slightly reduced test case:

module lorentz
  implicit none
  private
  public :: vector4_t
  public :: vector4_null
  public :: vector4_at_rest
  public :: vector4_moving
  public :: operator(*)
  public :: operator(**)
  type :: vector4_t
     real, dimension(0:3) :: p = &
        [0.0, 0.0, 0.0, 0.0]
  end type vector4_t

  type(vector4_t), parameter :: vector4_null = &
       vector4_t ([ 0.0, 0.0, 0.0, 0.0 ])

  interface vector4_moving
     module procedure vector4_moving_canonical
  end interface
  interface operator(*)
     module procedure prod_real_vector4, prod_vector4_real
     module procedure prod_integer_vector4, prod_vector4_integer
  end interface
  interface operator(*)
     module procedure prod_vector4
  end interface
  interface operator(**)
     module procedure power_vector4
  end interface

contains

  elemental function vector4_at_rest (m) result (p)
    type(vector4_t) :: p
    real, intent(in) :: m
    p = vector4_t ([ m, 0.0, 0.0, 0.0 ])
  end function vector4_at_rest

  elemental function vector4_moving_canonical (E, p, k) result (q)
    type(vector4_t) :: q
    real, intent(in) :: E, p
    integer, intent(in) :: k
    q = vector4_at_rest(E)
    q%p(k) = p
  end function vector4_moving_canonical

  elemental function prod_real_vector4 (s, p) result (q)
    type(vector4_t) :: q
    real, intent(in) :: s
    type(vector4_t), intent(in) :: p
    q%p = s * p%p
  end function prod_real_vector4
  elemental function prod_vector4_real (p, s) result (q)
    type(vector4_t) :: q
    real, intent(in) :: s
    type(vector4_t), intent(in) :: p
    q%p = s * p%p
  end function prod_vector4_real
  elemental function prod_integer_vector4 (s, p) result (q)
    type(vector4_t) :: q
    integer, intent(in) :: s
    type(vector4_t), intent(in) :: p
    q%p = s * p%p
  end function prod_integer_vector4
  elemental function prod_vector4_integer (p, s) result (q)
    type(vector4_t) :: q
    integer, intent(in) :: s
    type(vector4_t), intent(in) :: p
    q%p = s * p%p
  end function prod_vector4_integer

  elemental function prod_vector4 (p, q) result (s)
    real :: s
    type(vector4_t), intent(in) :: p,q
    s = p%p(0)*q%p(0) - dot_product(p%p(1:), q%p(1:))
  end function prod_vector4

  elemental function power_vector4 (p, e) result (s)
    real :: s
    type(vector4_t), intent(in) :: p
    integer, intent(in) :: e
    s = p * p
  end function power_vector4

end module lorentz



module flavors
  implicit none
  private
  public :: flavor_t
  type :: flavor_t
     private
     integer :: f = 0
   contains
     procedure :: init => flavor_init
  end type flavor_t
contains
  elemental subroutine flavor_init (flv, f)
    class(flavor_t), intent(inout) :: flv
    integer, intent(in) :: f
    flv%f = f
  end subroutine flavor_init
end module flavors



module particles
  use lorentz
  use flavors
  implicit none
  private
  public :: particle_t
  public :: particle_set_t

  type :: particle_t
     !private
     integer :: status = 0
     type(flavor_t) :: flv
     type(vector4_t) :: p = vector4_null
     real :: p2 = 0
     type(vector4_t), allocatable :: vertex
     integer, dimension(:), allocatable :: parent
   contains
    procedure :: set_flavor => particle_set_flavor
    procedure :: set_momentum => particle_set_momentum
    procedure :: set_parents => particle_set_parents
  end type particle_t

  type :: particle_set_t
     ! private !!!
     integer :: n_beam = 0
     integer :: n_in  = 0
     integer :: n_vir = 0
     integer :: n_out = 0
     integer :: n_tot = 0
     type(particle_t), dimension(:), allocatable :: prt
   contains
     procedure :: basic_init => particle_set_basic_init
     procedure :: init_direct => particle_set_init_direct
     generic :: set_momentum => set_momentum_all
     procedure :: set_momentum_all => particle_set_set_momentum_all
  end type particle_set_t

contains

  subroutine particle_set_flavor (prt, flv)
    class(particle_t), intent(inout) :: prt
    type(flavor_t), intent(in) :: flv
    prt%flv = flv
  end subroutine particle_set_flavor

  elemental subroutine particle_set_momentum (prt, p, p2)
    class(particle_t), intent(inout) :: prt
    type(vector4_t), intent(in) :: p
    real, intent(in), optional :: p2
    prt%p = p
    if (present (p2)) then
       prt%p2 = p2
    else
       prt%p2 = p ** 2
    end if
  end subroutine particle_set_momentum

  subroutine particle_set_parents (prt, idx)
    class(particle_t), intent(inout) :: prt
    integer, dimension(:), intent(in) :: idx
    if (allocated (prt%parent))  deallocate (prt%parent)
    allocate (prt%parent (count (idx /= 0)))
    prt%parent = pack (idx, idx /= 0)
  end subroutine particle_set_parents

  subroutine particle_set_basic_init (particle_set, n_beam, n_in, n_vir, n_out)
    class(particle_set_t), intent(out) :: particle_set
    integer, intent(in) :: n_beam, n_in, n_vir, n_out
    particle_set%n_beam = n_beam
    particle_set%n_in = n_in
    particle_set%n_vir = n_vir
    particle_set%n_out = n_out
    particle_set%n_tot = n_beam + n_in + n_vir + n_out
    allocate (particle_set%prt (particle_set%n_tot))
  end subroutine particle_set_basic_init

  subroutine particle_set_init_direct (particle_set, &
       n_beam, n_in, n_rem, n_vir, n_out, pdg)
    class(particle_set_t), intent(out) :: particle_set
    integer, intent(in) :: n_beam
    integer, intent(in) :: n_in
    integer, intent(in) :: n_rem
    integer, intent(in) :: n_vir
    integer, intent(in) :: n_out
    integer, dimension(:), intent(in) :: pdg
    type(flavor_t), dimension(:), allocatable :: flv
    integer :: i, k, n
    call particle_set%basic_init (n_beam, n_in, n_rem+n_vir, n_out)
    n = 0
    n = n + n_beam
    do i = n+1, n+n_in
       if (n_beam > 0) then
          call particle_set%prt(i)%set_parents &
               ([i-n_beam])
       end if
    end do
    n = n + n_in
    do i = n+1, n+n_rem
       if (n_beam > 0) then
          call particle_set%prt(i)%set_parents &
               ([i-n_in-n_beam])
       end if
    end do
    n = n + n_rem
    do i = n+1, n+n_vir
       call particle_set%prt(i)%set_parents &
            ([(k, k=n-n_rem-n_in+1, n-n_rem)])
    end do
    n = n + n_vir
    do i = n+1, n+n_out
       call particle_set%prt(i)%set_parents &
            ([(k, k=n-n_vir-n_rem-n_in+1, n-n_vir-n_rem)])
    end do
    allocate (flv (particle_set%n_tot))
    call flv%init (pdg)
    do i = 1, particle_set%n_tot
       call particle_set%prt(i)%set_flavor (flv(i))
    end do
  end subroutine particle_set_init_direct

  subroutine particle_set_set_momentum_all (particle_set, p, p2)
    class(particle_set_t), intent(inout) :: particle_set
    type(vector4_t), dimension(:), intent(in) :: p
    real, dimension(:), intent(in), optional :: p2
    call particle_set%prt%set_momentum (p, p2)
  end subroutine particle_set_set_momentum_all
end module particles



module isr_epa_handler_uti
  use lorentz, only: vector4_t, vector4_moving, operator(*)
  use particles, only: particle_set_t
  implicit none
  private
  public :: epa_handler_1

contains
  subroutine epa_handler_1 (u)
    integer, intent(in) :: u
    type(particle_set_t) :: pset
    type(vector4_t), dimension(8) :: p
    real :: sqrts
    call pset%init_direct &
         (n_beam = 2, n_in = 2, n_rem = 2, n_vir = 0, n_out = 2, &
         pdg = [11, -11, 22, 22, 11, -11, 13, -13])
    sqrts = 100.
    p(1) = vector4_moving (sqrts/2, sqrts/2, 3)
    p(2) = vector4_moving (sqrts/2,-sqrts/2, 3)
    p(7:8) = p(3:4)
    call pset%set_momentum (p)
  end subroutine epa_handler_1
end module isr_epa_handler_uti

program main_ut
  use isr_epa_handler_uti, only: epa_handler_1
  implicit none
  call epa_handler_1 (6)
end program main_ut

[Juergen_R_R]

@Barbara_P_Intelcould you please check on this?

[Barbara_P_Intel · Accepted solution]

I just compiled and ran both reproducers with a preview of ifx 2024.2.0. No seg faults!

Watch for the release of this version in mid-2024!