Hi Nvidia Team,
I don’t know what was really happened, I provide an example code below i don’t know is that happening on push array or someting else
module mytype_base_module
type, abstract :: mytype_base
integer :: length = 0
character(len=:),allocatable :: name
real, dimension(:,:), allocatable :: arr(:)
contains
procedure,PUBLIC :: alloc_mytype_base
procedure(i_check),PUBLIC,DEFERRED :: check
end type mytype_base
type,public :: mytype_arr
class(mytype_base), allocatable :: obj
end type mytype_arr
interface
subroutine i_check(me)
IMPORT
class(mytype_base),intent(in) :: me
end subroutine
end interface
contains
subroutine alloc_mytype_base(me, length)
class(mytype_base),intent(inout) :: me
integer,intent(in) :: length
me%length = length
allocate(me%arr(length))
me%arr = 0
end subroutine
subroutine push_type(mytypes, obj)
type(mytype_arr), dimension(:), allocatable, intent(inout) :: mytypes
class(mytype_base), intent(in) :: obj
type(mytype_arr), dimension(:), allocatable :: tmp
integer length
if(.not. allocated(mytypes)) then
allocate(mytypes(1))
allocate(mytypes(1)%obj ,source = obj)
else
length = size(mytypes)
allocate(tmp(length+1))
tmp(1:length) = mytypes(1:length)
allocate(tmp(1+length)%obj ,source = obj)
deallocate(mytypes)
allocate(mytypes(length+1))
mytypes = tmp
deallocate(tmp)
end if
end subroutine
end module mytype_base_module
module mytype1_module
use mytype_base_module
type, extends(mytype_base) :: mytype_1
double precision,dimension(:), allocatable :: arr2
contains
procedure :: alloc => alloc_mytype_1
procedure :: check => check_mytype_1
end type mytype_1
contains
! new
type(mytype_1) function new_mytype_1(name,length) result(obj)
character(len=*),intent(in):: name
integer,intent(in):: length
obj%name = name
call obj%alloc(length)
obj%arr = length + 1
obj%arr2 = length + 2
end function
subroutine alloc_mytype_1(me, length)
class(mytype_1),intent(inout) :: me
integer,intent(in) :: length
call me%alloc_mytype_base(length)
allocate(me%arr2(length))
me%arr2 = 0
end subroutine
subroutine check_mytype_1(me)
class(mytype_1),intent(in) :: me
integer l
print '(A,A15,i10)', me%name, " length = ", me%length
write(*,"(2A10)") "arr","arr2"
do l=1,me%length
write(*,"(I10,F10.3,F10.3)") l,me%arr(l),me%arr2(l)
end do
end subroutine
end module mytype1_module
program main
use mytype_base_module
use mytype1_module
type(mytype_arr), dimension(:), allocatable :: mytypes
type(mytype_1) :: my_a, my_b
my_a = new_mytype_1('foo',2)
my_b = new_mytype_1('bar',3)
call push_type(mytypes,my_b)
call push_type(mytypes,my_a)
call push_type(mytypes,my_b)
call mytypes(1)%obj%check()
call mytypes(2)%obj%check()
call mytypes(3)%obj%check()
print *, 'end'
end program
running on nvfortran
nvfortran ./test.f90 && ./a.out
bar length = 3
arr arr2
Segmentation fault
running on others
gfortran ./test.f90 && ./a.out
bar length = 3
arr arr2
1 4.000 5.000
2 4.000 5.000
3 4.000 5.000
foo length = 2
arr arr2
1 3.000 4.000
2 3.000 4.000
bar length = 3
arr arr2
1 4.000 5.000
2 4.000 5.000
3 4.000 5.000
end