Object assignment - issue with Ifort 18 (and not with previous versions).

[Jeremie_V_]

Dear,

I got the following run-time error when the program below is compiled with Intel Fortran 18.0.1.

forrtl: severe (188): An assignment was made from an object of one size to an object of a different size that cannot be deallocated

With debug options, it points to the following line (line 196 called from line 212 of the program below):

 othersparse=crssparse(sparse%dim1,nel,sparse%dim2,sparse%lupperstorage)

with crsparse is a constructor (function).

The program works fine with Intel Fortran 16 and 17, as well as with GNU Fortran 6 and 7.

Where is my mis-understanding/error?

module modsparse
 use iso_fortran_env,only:int32,int64,real32,real64,wp=>real32
 implicit none
 private
 public::coosparse,crssparse
 public::assignment(=)

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!GEN!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!aaa
 type,abstract::gen_sparse
  private
  integer(kind=int32)::unlog=6
  integer(kind=int32)::dim1,dim2
  character(len=15)::namemat='UNKNOWN'
  logical::lupperstorage
  contains
  private
  procedure(destroy_gen),public,deferred::destroy
  procedure::destroy_gen_gen
 end type
 
 abstract interface
  subroutine destroy_gen(sparse)
   import::gen_sparse
   class(gen_sparse),intent(inout)::sparse
  end subroutine
 end interface

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!COO!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!aaa
 type,extends(gen_sparse)::coosparse
  private
  integer(kind=int32),allocatable::ij(:,:)
  integer(kind=int64)::nel
  integer(kind=int64)::filled
  real(kind=wp),allocatable::a(:)
  contains
  private
  procedure,public::destroy=>destroy_scal_coo
  final::deallocate_scal_coo
 end type

 interface coosparse
  module procedure constructor_coo
 end interface
 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!CRS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!aaa
 type,extends(gen_sparse)::crssparse
  private
  integer(kind=int32),allocatable::ia(:)
  integer(kind=int32),allocatable::ja(:)
  real(kind=wp),allocatable::a(:)
  contains
  private
  procedure,public::destroy=>destroy_scal_crs
  final::deallocate_scal_crs
 end type

 interface crssparse
  module procedure constructor_crs
 end interface

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!GENERAL INTERFACES!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!aaa
 interface assignment(=)
  module procedure convertfromcootocrs
 end interface

contains

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!GEN!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!aaa
!DESTROY
subroutine destroy_gen_gen(sparse)
 class(gen_sparse),intent(inout)::sparse

 sparse%namemat='UNKNOWN'
 sparse%dim1=-1
 sparse%dim2=-1
 sparse%unlog=6
 sparse%lupperstorage=.false.

end subroutine

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!COO!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!aaa
!**CONSTRUCTOR
function constructor_coo(m,n,nel,lupper,unlog) result(sparse)
 type(coosparse)::sparse
 integer(kind=int32),intent(in)::m
 integer(kind=int32),intent(in),optional::n,unlog
 integer(kind=int64),intent(in),optional::nel
 logical,intent(in),optional::lupper

 sparse%namemat='COO'
 sparse%dim1=m
 sparse%dim2=m
 if(present(n))sparse%dim2=n

 sparse%filled=0_int64

 sparse%nel=100_int64
 allocate(sparse%ij(2,sparse%nel),sparse%a(sparse%nel))
 sparse%ij=0
 sparse%a=0._wp

 sparse%lupperstorage=.false.
 if(present(lupper))sparse%lupperstorage=lupper

 if(present(unlog))sparse%unlog=unlog

end function

!**DESTROY
subroutine destroy_scal_coo(sparse)
 class(coosparse),intent(inout)::sparse

 call sparse%destroy_gen_gen()

 sparse%nel=-1_int64
 sparse%filled=-1_int64
 if(allocated(sparse%ij))deallocate(sparse%ij)
 if(allocated(sparse%a))deallocate(sparse%a)

end subroutine

!FINAL
subroutine deallocate_scal_coo(sparse)
 type(coosparse),intent(inout)::sparse

 call destroy_scal_coo(sparse)

end subroutine

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!CRS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!aaa
!**CONSTRUCTOR
function constructor_crs(m,nel,n,lupper,unlog) result(sparse)
 type(crssparse)::sparse
 integer(kind=int32),intent(in)::m
 integer(kind=int32),intent(in)::nel
 integer(kind=int32),intent(in),optional::n,unlog
 logical,intent(in),optional::lupper

 sparse%namemat='CRS'
 sparse%dim1=m
 sparse%dim2=m
 if(present(n))sparse%dim2=n
 
 allocate(sparse%ia(sparse%dim1+1),sparse%ja(nel),sparse%a(nel))
 sparse%ia=0
 sparse%ia(sparse%dim1+1)=-nel
 sparse%ja=0
 sparse%a=0._wp

 sparse%lupperstorage=.false.
 if(present(lupper))sparse%lupperstorage=lupper

 if(present(unlog))sparse%unlog=unlog

end function

!**DESTROY
subroutine destroy_scal_crs(sparse)
 class(crssparse),intent(inout)::sparse

 call sparse%destroy_gen_gen()

 if(allocated(sparse%ia))deallocate(sparse%ia)
 if(allocated(sparse%ja))deallocate(sparse%ja)
 if(allocated(sparse%a))deallocate(sparse%a)

end subroutine

!FINAL
subroutine deallocate_scal_crs(sparse)
 type(crssparse),intent(inout)::sparse

 call destroy_scal_crs(sparse)

end subroutine

!CONVERSIONS
subroutine convertfromcootocrs(othersparse,sparse)
 type(crssparse),intent(out)::othersparse
 type(coosparse),intent(in)::sparse
 
 integer(kind=int32)::i,ndiag,nel,row,col
 integer(kind=int32),allocatable::rowpos(:)
 integer(kind=int64)::i8

 !Condition: all diagonal elements must be present

 !Number of elements=number of diagonal elements+number off-diagonal elements
 !from sparse
 ndiag=min(sparse%dim1,sparse%dim2)

 nel=ndiag

 othersparse=crssparse(sparse%dim1,nel,sparse%dim2,sparse%lupperstorage)

end subroutine

end module

program test
 use iso_fortran_env,only:int32,int64,wp=>real32
 use modsparse
 implicit none
 type(coosparse)::coo
 type(crssparse)::crs

 coo=coosparse(10,nel=4_int64,lupper=.false.)
  
 crs=coo

end program
 

Thank you for you help!

Jeremie

[Juergen_R_R]

Yes, I can reproduce this issue with ifort 18.0.5. However, the error is gone in ifort 19.0.1. I think you should file a report to Intel.

[Jeremie_V_]

Thank you Juergen for so quickly testing it with ifort 19.

I will send a report to Intel.

Yours sincerely,

Jeremie

[Jeremie_V_]

It has been confirmed by the Intel Support that it is a bug in all versions of v18.x.

A workaround is to use:

type(crssparse),intent(inout)::othersparse

instead of

type(crssparse),intent(out)::othersparse

See request #03792157 for more details.

Yours sincerely,

Jeremie