Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.
Announcements
Welcome to the Intel Community. If you get an answer you like, please mark it as an Accepted Solution to help others. Thank you!
26748 Discussions

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

Jeremie_V_
Beginner
175 Views

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

 

 

 

0 Kudos
3 Replies
Juergen_R_R
Valued Contributor I
175 Views

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_
Beginner
175 Views

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

I will send a report to Intel.

Yours sincerely,

Jeremie

Jeremie_V_
Beginner
175 Views

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

Reply