Am 06.12.20 um 15:40 schrieb Steve Lionel:
>
> There are two Fortran compilers in that suite. ifort uses the same
> homegrown backend Intel has been using all along, and by the time of its
> release it should support all of F2018. I find it works well. ifx uses
> an LLVM-based backend and is more problematic in the beta. I expect it
> to be shaky for a while.
>
Steve, Vipul,
thanks for your remarks. Looking at the installed package, indeed, there
seemed to be two backends behind. I first set things up with ifx, which
didn't work at all, so I changed to ifort (which is the 'classic' Intel
driver, as you say). Nevertheless, I get errors, one of which I reported
already to Intel as support issue #04894055 (maybe that is visible to
you). The failing code is attached below, if you want to have a look, it
is 277 lines, and half of it is from iso_varying_string. This is the
backtrace from the debugger:
[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.
0x000000000040c28d in do_deallocate_all ()
(gdb) bt
#0 0x000000000040c28d in do_deallocate_all ()
#1 0x00000000004084f2 in do_alloc_copy ()
#2 0x0000000000409661 in do_alloc_copy ()
#3 0x000000000040ae1e in for_alloc_assign_v2 ()
#4 0x0000000000405151 in
process_libraries_mp_process_def_import_component_ ()
#5 0x0000000000404285 in prc_test_uti_mp_prc_test_1_ ()
#6 0x00000000004029f9 in MAIN__ ()
module iso_varying_string
implicit none
type, public :: varying_string
private
character(LEN=1), dimension(:), allocatable :: chars
end type varying_string
interface assignment(=)
module procedure op_assign_CH_VS
module procedure op_assign_VS_CH
end interface assignment(=)
interface operator(//)
module procedure op_concat_VS_VS
module procedure op_concat_CH_VS
module procedure op_concat_VS_CH
end interface operator(//)
interface char
module procedure char_auto
module procedure char_fixed
end interface char
interface len
module procedure len_
end interface len
interface var_str
module procedure var_str_
end interface var_str
public :: assignment(=)
public :: operator(//)
public :: char
public :: len
public :: var_str
private :: op_assign_CH_VS
private :: op_assign_VS_CH
private :: op_concat_VS_VS
private :: op_concat_CH_VS
private :: op_concat_VS_CH
private :: char_auto
private :: char_fixed
private :: len_
private :: var_str_
contains
elemental function len_ (string) result (length)
type(varying_string), intent(in) :: string
integer :: length
if(ALLOCATED(string%chars)) then
length = SIZE(string%chars)
else
length = 0
endif
end function len_
elemental subroutine op_assign_CH_VS (var, exp)
character(LEN=*), intent(out) :: var
type(varying_string), intent(in) :: exp
var = char(exp)
end subroutine op_assign_CH_VS
elemental subroutine op_assign_VS_CH (var, exp)
type(varying_string), intent(out) :: var
character(LEN=*), intent(in) :: exp
var = var_str(exp)
end subroutine op_assign_VS_CH
elemental function op_concat_VS_VS (string_a, string_b) result
(concat_string)
type(varying_string), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
type(varying_string) :: concat_string
integer :: len_string_a
len_string_a = len(string_a)
ALLOCATE(concat_string%chars(len_string_a+len(string_b)))
concat_string%chars(:len_string_a) = string_a%chars
concat_string%chars(len_string_a+1:) = string_b%chars
end function op_concat_VS_VS
elemental function op_concat_CH_VS (string_a, string_b) result
(concat_string)
character(LEN=*), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
type(varying_string) :: concat_string
concat_string = op_concat_VS_VS(var_str(string_a), string_b)
end function op_concat_CH_VS
elemental function op_concat_VS_CH (string_a, string_b) result
(concat_string)
type(varying_string), intent(in) :: string_a
character(LEN=*), intent(in) :: string_b
type(varying_string) :: concat_string
concat_string = op_concat_VS_VS(string_a, var_str(string_b))
end function op_concat_VS_CH
pure function char_auto (string) result (char_string)
type(varying_string), intent(in) :: string
character(LEN=len(string)) :: char_string
integer :: i_char
forall(i_char = 1:len(string))
char_string(i_char:i_char) = string%chars(i_char)
end forall
end function char_auto
pure function char_fixed (string, length) result (char_string)
type(varying_string), intent(in) :: string
integer, intent(in) :: length
character(LEN=length) :: char_string
char_string = char(string)
end function char_fixed
elemental function var_str_ (char) result (string)
character(LEN=*), intent(in) :: char
type(varying_string) :: string
integer :: length
integer :: i_char
length = LEN(char)
ALLOCATE(string%chars(length))
forall(i_char = 1:length)
string%chars(i_char) = char(i_char:i_char)
end forall
end function var_str_
end module iso_varying_string
!!!!!!
module particle_specifiers
use iso_varying_string, string_t => varying_string
implicit none
private
public :: prt_spec_t
public :: new_prt_spec
type :: prt_spec_t
private
type(string_t) :: name
type(string_t), dimension(:), allocatable :: decay
end type prt_spec_t
interface new_prt_spec
module procedure new_prt_spec
end interface new_prt_spec
contains
elemental function new_prt_spec (name) result (prt_spec)
type(string_t), intent(in) :: name
type(prt_spec_t) :: prt_spec
prt_spec%name = name
end function new_prt_spec
end module particle_specifiers
!!!!!
module process_libraries
use iso_varying_string, string_t => varying_string
use particle_specifiers
implicit none
private
public :: process_component_def_t
public :: process_def_t
type :: process_component_def_t
private
logical :: initial = .false.
integer :: n_in = 0
type(prt_spec_t), dimension(:), allocatable :: prt_in
type(string_t) :: description
end type process_component_def_t
type :: process_def_t
private
type(string_t) :: id
integer :: n_in = 0
integer :: n_initial = 0
type(process_component_def_t), dimension(:), allocatable :: initial
contains
procedure :: init => process_def_init
procedure :: import_component => process_def_import_component
end type process_def_t
type :: process_library_entry_t
private
type(process_def_t), pointer :: def => null ()
contains
procedure :: init => process_library_entry_init
end type process_library_entry_t
contains
subroutine process_def_init (def, id, &
n_in, n_components)
class(process_def_t), intent(out) :: def
type(string_t), intent(in), optional :: id
integer, intent(in), optional :: n_in
integer, intent(in), optional :: n_components
if (present (id)) then
def%id = id
else
def%id = ""
end if
if (present (n_in)) def%n_in = n_in
if (present (n_components)) then
def%n_initial = n_components
allocate (def%initial (n_components))
end if
def%initial%initial = .true.
def%initial%description = ""
end subroutine process_def_init
subroutine process_def_import_component (def, &
i, prt_in)
class(process_def_t), intent(inout) :: def
integer, intent(in) :: i
type(prt_spec_t), dimension(:), intent(in), optional :: prt_in
integer :: p
associate (comp => def%initial(i))
if (present (prt_in)) then
allocate (comp%prt_in (size (prt_in)))
comp%prt_in = prt_in
end if
if (allocated (comp%prt_in)) then
associate (d => comp%description)
d = ""
d = d // " => "
end associate
end if
end associate
end subroutine process_def_import_component
subroutine process_library_entry_init (object, def)
class(process_library_entry_t), intent(out) :: object
type(process_def_t), target, intent(in) :: def
object%def => def
end subroutine process_library_entry_init
end module process_libraries
!!!!!
module prc_test_uti
use iso_varying_string, string_t => varying_string
use particle_specifiers, only: new_prt_spec
use process_libraries
implicit none
private
public :: prc_test_1
contains
subroutine prc_test_1 ()
type(process_def_t), pointer :: entry
type(string_t), dimension(:), allocatable :: prt_in
allocate (prt_in (2))
prt_in = [var_str ("s"), var_str ("s")]
allocate (entry)
call entry%init (var_str ("prc_test1_a"), &
n_in = 2, n_components = 1)
call entry%import_component (1, &
prt_in = new_prt_spec (prt_in))
end subroutine prc_test_1
end module prc_test_uti
!!!!!
program main_ut
use prc_test_uti, only: prc_test_1
implicit none
call prc_test_1 ()
end program main_ut
--
Juergen Reuter
Theoretical Particle Physics
Deutsches Elektronen-Synchrotron (DESY)
Hamburg, Germany