Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.
28381 Discussions

ifort 15 compile time error with adj3.f90

may_ka
Beginner
806 Views

Hi there

getting

ifort -o adj3 adj3.f90 -stand=f03

adj3.f90(190): error #6303:
The assignment operation or the binary expression operation is
invalid for the data types of the two operands. 
  adj = a
--------^

when compiling adj3.f90 downloaded from here: https://software.intel.com/sites/default/files/managed/14/e9/adj3.f90

Any idea?

Thanks

0 Kudos
15 Replies
Kevin_D_Intel
Employee
806 Views

From a quick glance this appears similar to an earlier report, http://software.intel.com/forums/topic/488776. I’ll do a closure inspection and follow-up shortly.

0 Kudos
TimP
Honored Contributor III
806 Views

The source code appears to assign a rank 2 array to a rank 3.  The error message might be made more helpful.
 

0 Kudos
may_ka
Beginner
806 Views

Hi there

the complete error message is:

adj3.f90(190): error #6303: The assignment operation or the binary expression operation is invalid for the data types of the two operands.   
  adj = a
--------^
adj3.f90(190): error #6366: The shapes of the array expressions do not conform.   [ADJ]
  adj = a
--^

However, as far as I understand the source code "a" is of rank 2, and the unlimited polymorphic pointer in "adj" is of rank 2 too.

Cheers

0 Kudos
Kevin_D_Intel
Employee
806 Views

I believe the code is conformant and that the compiler errors are incorrect. I escalated the issue to the Fortran Developers for a closer look under the internal tracking id below. I was unable to find a work around. I will keep you updated as I learn more.

(Internal tracking id: DPD200375239)

(Resolution Update on 09/26/2015): Closed - not a defect. See subsequent replies.

0 Kudos
Kevin_D_Intel
Employee
806 Views

My apologies, I was wrong. I thought there might be a relation to an earlier issue from FortranFan,  https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/506867, but Development says your program is not conformant and this is not a defect.

They said the compiler error occurs because the LHS of a defined assignment is not polymorphic but the corresponding dummy in the assignment routine is polymorphic and is allocatable.  They point to the Fortran 2008 Standard, page 295, Line 18 that says the actual argument shall be polymorphic if and only if the associated dummy argument is polymorphic. Note 12.27 explains why.

So for your test case they said the compiler takes adj = a  to be an intrinsic assignment, and issues an error.  If adj is declared to be polymorphic then adj = a works; however, they note that intrinsic assignment to a polymorphic variable is wrong and so then the following line would be an error adj = adj_matrix(INT(8,8),2,4) when adj is polymorphic.

I’d like ask FortranFan, IanH, mecej4, or others with a strong understanding of the polymorphism features for some help with suggesting the proper changes needed to make the code conformant.

0 Kudos
FortranFan
Honored Contributor II
806 Views

Kevin Davis (Intel) wrote:

My apologies, I was wrong. I thought there might be a relation to an earlier issue from FortranFan,  https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/506867, but Development says your program is not conformant and this is not a defect.

They said the compiler error occurs because the LHS of a defined assignment is not polymorphic but the corresponding dummy in the assignment routine is polymorphic and is allocatable.  They point to the Fortran 2008 Standard, page 295, Line 18 that says the actual argument shall be polymorphic if and only if the associated dummy argument is polymorphic. Note 12.27 explains why.

So for your test case they said the compiler takes adj = a  to be an intrinsic assignment, and issues an error.  If adj is declared to be polymorphic then adj = a works; however, they note that intrinsic assignment to a polymorphic variable is wrong and so then the following line would be an error adj = adj_matrix(INT(8,8),2,4) when adj is polymorphic.

I’d like ask FortranFan, IanH, mecej4, or others with a strong understanding of the polymorphism features for some help with suggesting the proper changes needed to make the code conformant.

Intel compiler development team is correct in that there does appear to be problems with the code in the original post.  The feedback from development about the issue of "the LHS of a defined assignment is not polymorphic but the corresponding dummy in the assignment routine is polymorphic" is genuine.  Nonetheless, Intel Fortran is not totally off-the-hook here.  The code in the original post has a base matrix type based on parameterized derived types (PDTs).  With PDTs, there are problems in Intel Fortran with procedures that operate on them due to implementation issues.  But I don't believe this is news - Intel has a few open incidents with PDTs, including several that I have reported.

Now re: the comment about "help with suggesting the proper changes needed to make the code conformant," that is rather difficult in this situation.  It appears the code is copyrighted to NVIDIA corporation and it is unclear what they have in mind regarding the design of their matrix derived type, for there would many questions about why things are setup the way they are.  For one thing, the base matrix class is a PDT but the extended class doesn't seem to use any of the PDT features; it's unclear why polymorphic dummy argument is used in the defined assignments; the invoking program doesn't seem consistent with the class design, and so forth.  Anyways, if someone wants to modify the code, they can start by considering a simpler design such as one in an example shown below where PDTs and polymorphic LHS are avoided in the defined assignment procedures to get some working code that is by-and-large equivalent to the main program in the original post.

module matrix

   use, intrinsic :: iso_fortran_env, only : r4 => real32, r8 => real64

   type :: adj_matrix
      private
      class(*), allocatable :: m(:,:)
   end type adj_matrix

   interface assignment (=)
      module procedure a2m           ! assign array
      module procedure m2a_r8        ! assign matrix to real(r8) array
   end interface assignment(=)

contains

   subroutine a2m(d,s)

      class(adj_matrix), intent(inout)     :: d
      class(*), dimension(:,:), intent(in) :: s

      integer :: istat

      istat = 0
      if ( allocated(d%m) ) then
         deallocate(d%m, stat=istat)
      end if

      if (istat == 0) then
         allocate(d%m(size(s,1),size(s,2)), source=s)
      end if

   end subroutine a2m

   subroutine m2a_r8(a,this)

      class(adj_matrix), intent(in)      :: this
      real(r8), allocatable, intent(out) :: a(:,:)

      select type ( m => this%m )
         type is ( real(r8) )
            a = m
         class default
      end select

   end subroutine m2a_r8

end module matrix
program adj3

   use matrix

   implicit none

   integer, parameter :: N = 2
   integer, parameter :: M = 3
   type(adj_matrix), allocatable :: adj
   real(r8) :: a(N,M)
   real(r8), allocatable :: b(:,:)
   integer :: i

   allocate(adj)
   a = reshape( [( real(i, kind=r8), i=1,N*M )], [ N,M ] )

   adj = a

   b = adj
   print * , " b = ", b

   stop

end program adj3

Upon execution,

  b =  1.00000000000000 2.00000000000000 3.00000000000000
 4.00000000000000 5.00000000000000 6.00000000000000
Press any key to continue . . .

The above is just a possible example for set/get accessor type of procedures that overload the defined assignment; of course, depending on one's needs and preferences, there are other options one can employ.

 

0 Kudos
FortranFan
Honored Contributor II
806 Views

FortranFan wrote:

.. With PDTs, there are problems in Intel Fortran with procedures that operate on them due to implementation issues ..

To illustrate some of the issues, the following variant making use of the PDTs the same way as in the original code does not generate any errors during compilation of matrix module, but the program compilation results in the same error as mentioned in the original post:

module matrix

   use, intrinsic :: iso_fortran_env, only : i4 => int32, i8 => int64, r4 => real32, r8 => real64

   type :: base_matrix(k,c,r)
      private
      integer, kind :: k = r4
      integer, len :: c = 1
      integer, len :: r = 1
   end type base_matrix

   type, extends(base_matrix) :: adj_matrix
      private
      class(*), allocatable :: m(:,:)
   end type adj_matrix

   interface adj_matrix
      module procedure construct_r4   ! constructor with r4 array
      module procedure construct_r8   ! constructor with r8 array
   end interface adj_matrix

   interface assignment (=)
      module procedure a2m           ! assign array
      module procedure m2a_r8        ! assign matrix to real(r8) array
      !.. additional procedures elided
   end interface assignment(=)

contains

   function construct_r8(k,c,r) result(mat)

      integer(i8), intent(in) :: k
      integer, intent(in) :: c
      integer, intent(in) :: r
      class(adj_matrix(r8,:,:)), allocatable :: mat

      if (k == int(r8, kind(k)) ) then
         allocate( adj_matrix(r8,c=c,r=r) :: mat)
      end if

   end function construct_r8

   function construct_r4(k,c,r) result(mat)

      integer(i4), intent(in) :: k
      integer, intent(in) :: c
      integer, intent(in) :: r
      class(adj_matrix(r4,:,:)), allocatable :: mat

      if (k == int(r4, kind(k)) ) then
         allocate( adj_matrix(r4,c=c,r=r) :: mat)
      end if

   end function construct_r4

   subroutine a2m(d, s)

      class(adj_matrix), intent(inout)     :: d
      class(*), dimension(:,:), intent(in) :: s

      integer :: istat

      istat = 0
      if ( allocated(d%m) ) then
         deallocate(d%m, stat=istat)
      end if

      if (istat == 0) then
         allocate(d%m(size(s,1),size(s,2)), source=s)
      end if

   end subroutine a2m

   subroutine m2a_r8(a, this)

      class(adj_matrix), intent(in)      :: this
      real(r8), allocatable, intent(out) :: a(:,:)

      select type ( m => this%m )
         type is ( real(r8) )
            a = m
         class default
      end select

   end subroutine m2a_r8

end module matrix
program adj3

   use matrix

   implicit none

   integer, parameter :: N = 2
   integer, parameter :: M = 3
   type(adj_matrix(r8,:,:)), allocatable :: adj
   real(r8) :: a(N,M)
   real(r8), allocatable :: b(:,:)
   integer :: i

   adj = adj_matrix(k=int(r8,kind=i8), c=N, r=M)
   a = reshape( [( real(i, kind=r8), i=1,N*M )], [ N,M ] )

   adj = a

   b = adj
   print * , " b = ", b

   stop

end program adj3

Upon compilation,

1>Compiling with Intel(R) Visual Fortran Compiler 16.0 [Intel(R) 64]...
1>m.f90
1>p.f90
1>p.f90(17): error #6303: The assignment operation or the binary expression operation is invalid for the data types of the two operands.   
1>p.f90(17): error #6366: The shapes of the array expressions do not conform.   [ADJ]
1>p.f90(19): error #6303: The assignment operation or the binary expression operation is invalid for the data types of the two operands.   [ADJ]
1>compilation aborted for p.f90 (code 1)

However, I'm not completely sure about the dummy argument declarations for PDT as simply class(adj_matrix) in a2m and m2a_r8 procedures that overload the defined assignment: the compiler doesn't complain, but the kind parameter, I believe, is supposed to be a compile-time constant and the language doesn't seem to offer a generic or a deferred type of facility for it.  So I think there is something the compiler is overlooking in the module procedures of a2m and m2a_r8 which is then leading to an error during the compilation of program adj3.

0 Kudos
FortranFan
Honored Contributor II
806 Views

FortranFan wrote:

.. However, I'm not completely sure about the dummy argument declarations for PDT as simply class(adj_matrix) in a2m and m2a_r8 procedures that overload the defined assignment: the compiler doesn't complain, but the kind parameter, I believe, is supposed to be a compile-time constant and the language doesn't seem to offer a generic or a deferred type of facility for it.  So I think there is something the compiler is overlooking in the module procedures of a2m and m2a_r8 which is then leading to an error during the compilation of program adj3.

So with the modified dummy argument declaration as shown below, the code works however the type definition is still questionable as the PDT features are not really utilized:

module matrix

   use, intrinsic :: iso_fortran_env, only : i4 => int32, i8 => int64, r4 => real32, r8 => real64

   type :: base_matrix(k,c,r)
      private
      integer, kind :: k = r4
      integer, len :: c = 1
      integer, len :: r = 1
   end type base_matrix

   type, extends(base_matrix) :: adj_matrix
      private
      class(*), allocatable :: m(:,:)
   end type adj_matrix

   interface adj_matrix
      module procedure construct_r4   ! constructor with r4 array
      module procedure construct_r8   ! constructor with r8 array
   end interface adj_matrix

   interface assignment (=)
      module procedure a2m           ! assign array
      module procedure m2a_r8        ! assign matrix to real(r8) array
      !.. additional procedures elided
   end interface assignment(=)

contains

   function construct_r8(k,c,r) result(mat)

      integer(i8), intent(in) :: k
      integer, intent(in) :: c
      integer, intent(in) :: r
      class(adj_matrix(r8,:,:)), allocatable :: mat

      if (k == int(r8, kind(k)) ) then
         allocate( adj_matrix(r8,c=c,r=r) :: mat)
      end if

   end function construct_r8

   function construct_r4(k,c,r) result(mat)

      integer(i4), intent(in) :: k
      integer, intent(in) :: c
      integer, intent(in) :: r
      class(adj_matrix(r4,:,:)), allocatable :: mat

      if (k == int(r4, kind(k)) ) then
         allocate( adj_matrix(r4,c=c,r=r) :: mat)
      end if

   end function construct_r4

   subroutine a2m(d, s)

      class(adj_matrix(k=r8,c=*,r=*)), intent(inout) :: d
      class(*), dimension(:,:), intent(in)           :: s

      integer :: istat

      istat = 0
      if ( allocated(d%m) ) then
         deallocate(d%m, stat=istat)
      end if

      if (istat == 0) then
         allocate(d%m(size(s,1),size(s,2)), source=s)
      end if

   end subroutine a2m

   subroutine m2a_r8(a, this)

      class(adj_matrix(k=r8,c=*,r=*)), intent(in) :: this
      real(r8), allocatable, intent(out)          :: a(:,:)

      select type ( m => this%m )
         type is ( real(r8) )
            a = m
         class default
      end select

   end subroutine m2a_r8

end module matrix
program adj3

   use matrix

   implicit none

   integer, parameter :: N = 2
   integer, parameter :: M = 3
   type(adj_matrix(r8,:,:)), allocatable :: adj
   real(r8) :: a(N,M)
   real(r8), allocatable :: b(:,:)
   integer :: i

   adj = adj_matrix(k=int(r8,kind=i8), c=N, r=M)
   a = reshape( [( real(i, kind=r8), i=1,N*M )], [ N,M ] )

   adj = a

   b = adj
   print * , " b = ", b

   stop

end program adj3
  b =  1.00000000000000 2.00000000000000 3.00000000000000
 4.00000000000000 5.00000000000000 6.00000000000000
Press any key to continue . . .

 

0 Kudos
FortranFan
Honored Contributor II
806 Views

Kevin Davis (Intel) wrote:

.. I’d like ask ..  with a strong understanding of the polymorphism features for some help with suggesting the proper changes needed to make the code conformant.

@Kevin,

Here's a possible alternative to the code in the original post which can work using Intel Fortran compiler 16 in a manner suggested by the main program in the original code.  Perhaps OP can take something like this and modify as needed.

module mykinds

   use, intrinsic :: iso_fortran_env, only : i4 => int32, r4 => real32, r8 => real64

   implicit none

   private

   public :: i4, r4, r8

end module mykinds
module matrix

   use mykinds, only : r4, r8

   implicit none

   private

   type, public :: mat_t(k,c,r)
      
      !.. type parameters
      integer, kind :: k = r4
      integer, len  :: c = 1
      integer, len  :: r = 1
      
      !.. private by default
      private
      
      !.. type data
      real(kind=k)  :: m_a(c,r)
      
   end type mat_t

   interface assignment(=)
      module procedure geta_r4
      module procedure seta_r4
      module procedure geta_r8
      module procedure seta_r8
      !.. additional bindings elided
   end interface

   public :: assignment(=)
   
contains

   subroutine geta_r4(a_lhs, t_rhs)

      real(r4), allocatable, intent(out)     :: a_lhs(:,:)
      class(mat_t(k=r4,c=*,r=*)), intent(in) :: t_rhs

      a_lhs = t_rhs%m_a

      return

   end subroutine geta_r4

   subroutine geta_r8(a_lhs, t_rhs)

      real(r8), allocatable, intent(out)     :: a_lhs(:,:)
      class(mat_t(k=r8,c=*,r=*)), intent(in) :: t_rhs

      a_lhs = t_rhs%m_a

      return

   end subroutine geta_r8

   subroutine seta_r4(t_lhs, a_rhs)

      class(mat_t(k=r4,c=*,r=*)), intent(inout) :: t_lhs
      real(r4), intent(in)                      :: a_rhs(:,:)

      !.. checks on size elided
      t_lhs%m_a = a_rhs 

      return

   end subroutine seta_r4

   subroutine seta_r8(t_lhs, a_rhs)

      class(mat_t(k=r8,c=*,r=*)), intent(inout) :: t_lhs
      real(r8), intent(in)                      :: a_rhs(:,:)

      !.. checks on size elided
      t_lhs%m_a = a_rhs 

      return

   end subroutine seta_r8

end module matrix
program p

   use mykinds, only : r8
   use matrix, only : mat_t, assignment(=)

   implicit none

   integer, parameter :: N = 2
   integer, parameter :: M = 3

   type(mat_t(k=r8,c=:,r=:)), allocatable :: mat

   real(r8), allocatable :: a(:,:)
   real(r8), allocatable :: b(:,:)

   integer :: i
   integer :: istat

   allocate( mat_t(k=r8,c=N,r=M) :: mat, stat=istat )
   if ( istat /= 0 ) then
      print *, " error allocating mat: stat = ", istat
      stop
   end if
    
   print *, " matrix mat: kind     = ", mat%k
   print *, " matrix mat: num cols = ", mat%c
   print *, " matrix mat: num rows = ", mat%r

   a = reshape( [ (real(i, kind=mat%k), i=1,N*M) ], [ N, M ] )
   mat = a

   b = mat
   print *, " b = ", b

   deallocate( mat, stat=istat )
   if ( istat /= 0 ) then
      print *, " error deallocating mat: stat = ", istat
      stop
   end if
    
   stop

end program p

Upon execution using Intel Fortran compiler 16,

  matrix mat: kind     =  8
  matrix mat: num cols =  2
  matrix mat: num rows =  3
  b =  1.00000000000000 2.00000000000000 3.00000000000000
 4.00000000000000 5.00000000000000 6.00000000000000
Press any key to continue . . .

 

0 Kudos
FortranFan
Honored Contributor II
806 Views

Kevin Davis (Intel) wrote:

.. I’d like ask ..  with a strong understanding of the polymorphism features for some help with suggesting the proper changes needed to make the code conformant.

@Kevin,

See message #10 for reference.  Ideally I would prefer to set up the PDT with type-bound procedures as shown below and this code should be essentially equivalent to the working example in message #10.  However, the main program fails to compile with the same error message as reported in the original post.  My contention is that in this particular case, the issue is not non-conforming code, rather it is a problem in the Intel compiler itself. I believe it has to do with outstanding issues with PDT implementation in Intel Fortran when it comes to the procedure-binding feature.  Along with the cases mentioned in message #8, I would request you to forward these cases to Intel compiler development team for their feedback and possibly add these to the stack of incidents awaiting improvements with PDT implementation in Intel Fortran.  Thanks,

module mykinds

   use, intrinsic :: iso_fortran_env, only : i4 => int32, r4 => real32, r8 => real64

   implicit none

   private

   public :: i4, r4, r8

end module mykinds
module matrix

   use mykinds, only : r4, r8

   implicit none

   private

   type, public :: mat_t(k,c,r)
      
      !.. type parameters
      integer, kind :: k = r4
      integer, len  :: c = 1
      integer, len  :: r = 1
      
      !.. all data private by default
      private
      
      !.. type data
      real(kind=k) :: m_a(c,r)

   contains

      !.. all bindings private by default
      private

      !.. private procedures
      procedure, pass(t_rhs) :: geta_r4
      procedure, pass(t_lhs) :: seta_r4
      procedure, pass(t_rhs) :: geta_r8
      procedure, pass(t_lhs) :: seta_r8
      !.. additional bindings elided

      !.. public methods
      generic, public :: assignment => geta_r4, seta_r4, geta_r8, seta_r8
      
   end type mat_t

contains

   subroutine geta_r4(a_lhs, t_rhs)

      real(r4), allocatable, intent(out)     :: a_lhs(:,:)
      class(mat_t(k=r4,c=*,r=*)), intent(in) :: t_rhs

      a_lhs = t_rhs%m_a

      return

   end subroutine geta_r4

   subroutine geta_r8(a_lhs, t_rhs)

      real(r8), allocatable, intent(out)     :: a_lhs(:,:)
      class(mat_t(k=r8,c=*,r=*)), intent(in) :: t_rhs

      a_lhs = t_rhs%m_a

      return

   end subroutine geta_r8

   subroutine seta_r4(t_lhs, a_rhs)

      class(mat_t(k=r4,c=*,r=*)), intent(inout) :: t_lhs
      real(r4), intent(in)                      :: a_rhs(:,:)

      !.. checks on size elided
      t_lhs%m_a = a_rhs 

      return

   end subroutine seta_r4

   subroutine seta_r8(t_lhs, a_rhs)

      class(mat_t(k=r8,c=*,r=*)), intent(inout) :: t_lhs
      real(r8), intent(in)                      :: a_rhs(:,:)

      !.. checks on size elided
      t_lhs%m_a = a_rhs 

      return

   end subroutine seta_r8

end module matrix
program p

   use mykinds, only : r8
   use matrix, only : mat_t

   implicit none

   integer, parameter :: N = 2
   integer, parameter :: M = 3

   type(mat_t(k=r8,c=:,r=:)), allocatable :: mat

   real(r8), allocatable :: a(:,:)
   real(r8), allocatable :: b(:,:)

   integer :: i
   integer :: istat

   allocate( mat_t(k=r8,c=N,r=M) :: mat, stat=istat )
   if ( istat /= 0 ) then
      print *, " error allocating mat: stat = ", istat
      stop
   end if
    
   print *, " matrix mat: kind     = ", mat%k
   print *, " matrix mat: num cols = ", mat%c
   print *, " matrix mat: num rows = ", mat%r

   a = reshape( [ (real(i, kind=mat%k), i=1,N*M) ], [ N, M ] )
   mat = a

   b = mat
   print *, " b = ", b

   deallocate( mat, stat=istat )
   if ( istat /= 0 ) then
      print *, " error deallocating mat: stat = ", istat
      stop
   end if
    
   stop

end program p

So note the module matrix compiles with no errors or warning with compiler 16 version.  However, the program p fails as below:

1>------ Build started: Project: p, Configuration: Debug x64 ------
1>Compiling with Intel(R) Visual Fortran Compiler 16.0 [Intel(R) 64]...
1>m.f90
1>p.f90
1>p.f90(30): error #6303: The assignment operation or the binary expression operation is invalid for the data types of the two operands.   
1>p.f90(30): error #6366: The shapes of the array expressions do not conform.   [MAT]
1>p.f90(32): error #6303: The assignment operation or the binary expression operation is invalid for the data types of the two operands.   [MAT]
1>compilation aborted for p.f90 (code 1)

 

As a final comment, please note PDT feature from Fortran 2003 standard is indeed of great importance and a robust implementation of it in Intel Fortran can greatly enhance the applicability and value the compiler can provide to its users.  Prompt and thorough resolution to the few outstanding issues with PDTs (as shown above and reported elsewhere on the two Fortran forums) will be greatly appreciated and it will go a long way toward Intel being able to truly claim it is a fully Fortran 2003-compliant compiler (how about 2015 itself as the year to achieve this!).

0 Kudos
Kevin_D_Intel
Employee
806 Views

Many thanks FortranFan!  I will work through your replies soon.

0 Kudos
FortranFan
Honored Contributor II
806 Views

Kevin Davis (Intel) wrote:

Many thanks FortranFan!  I will work through your replies soon.

Hello Kevin,

Is there any update on the issues listed in this thread with PDTs in Intel Fortran, in particular the couple of cases I show in Message #8 and #11 respectively?

After the compiler bug fix list for compiler 16, update 1, I see several previous incidents have been resolved but the two cases in Message #8 and #11 in this thread still give errors with update 1.  I am not sure if tracking incidents were submitted for these cases.  Will it be possible to do so?  That will help bring these cases to the attention of Intel development.

Thanks much,

0 Kudos
Kevin_D_Intel
Employee
806 Views

My apologies FortranFan. I am admittedly behind. I submitted the two cases (from messages #8 & #11) to Development.

(Internal tracking id: DPD200378912 - Unexpected errors #6303 and #6366 - message #8) -  (Refer to next reply #15 for resolution details)
(Internal tracking id: DPD200378914 - Unexpected errors #6303 and #6366 - message #11)

(Resolution Update on 05/26/2016 for DPD200378914): This defect is fixed in the Intel® Parallel Studio XE 2016 Update 3 Release (ifort Version 16.0.3.210 Build 20160415 - PSXE 2016.3.067 / CnL 2016.3.210- Linux)

0 Kudos
Kevin_D_Intel
Employee
806 Views

Development analyzed and closed (as not a defect) the internal id DPD200378912 corresponding to post #8. Here is their analysis:

The user program declares two specific procedures for defined assignment with the dummy arguments declared as class(adj_matrix).

Note that the kind parameter has the default value "r4", so these dummy arguments are objects of type adj_matrix with kind parameter value "r4".

The user says ".. but the kind parameter, I believe, is supposed to be a compile-time constant and the language doesn't seem to offer a generic or a deferred type of facility for it.  So I think there is something the compiler is overlooking in the module procedures of a2m and m2a_r8 which is then leading to an error during the compilation of program adj3.”

It is correct that the kind parameter is a compile time constant and it cannot be generic or deferred. Hence, for the generic resolution of defined assignment to work as the user intends, the dummy argument and the corresponding actual argument ( the LHS of the assignment in this case) should have the same kind parameter value.

Refer F2008 Pg 50, Note 4.1 which says "A type parameter of a derived type may be specified to be a kind type parameter in order to allow generic resolution based on the parameter; that is to allow a single generic to include two specific procedures that have interfaces distinguished only by the value of a kind type parameter of a dummy argument. All generic references are resolvable at compile time."

In the example given, adj is declared with kind parameter value of "r8". type(adj_matrix(r8,:,:)), allocatable :: adj whereas the dummy arguments use the default value of "r4".

So there is no matching specific for the generic defined assignment. If the dummy arguments in a2m and m2a_r8 are changed to be
class(adj_matrix(r8,*,*)) or if the object "adj" is declared as type(adj_matrix(r4,:,:)), allocatable :: adj, then the program works fine and we get

D:\test\cq378912>cq378912.exe
  b =    1.00000000000000        2.00000000000000        3.00000000000000
   4.00000000000000        5.00000000000000        6.00000000000000

Development also analyzed DPD200378914 and has fix targeted for PSXE 2015 Update 3 (sorry, it did not make the newest Update 2) for a variant of your program. For this issue I created a "fail" case corresponding to your program in post #11, and "pass" case corresponding to the program in post #10. With that in mind, regarding this issue, Development wrote:

The given user program matrix.f90 in the 'fail' folder uses a type bound generic whereas the one inside 'work' folder uses a generic interface block. The type bound generic inside type mat_t is declared as

generic, public :: assignment => geta_r4, seta_r4, geta_r8, seta_r8

Note that this syntax specifies a generic procedure named "assignment" and not a defined assignment (there is no "(=)" following the keyword 'assignment'). So, the errors given are correct for the attached program.

However, if I change the type bound generic to specify a defined assignment,

generic, public :: assignment (=) => geta_r4, seta_r4, geta_r8, seta_r8

then also the errors are given, which is incorrect. I have fixed this bug.

 

0 Kudos
Kevin_D_Intel
Employee
806 Views

@FortranFan - I confirmed the final open defect in this post (Internal tracking id: DPD200378914 - Unexpected errors #6303 and #6366 - message #11) is fixed in the Intel® Parallel Studio XE 2016 Update 3 release. The program, when modified accordingly per reply #15, now compiles and runs successfully.

0 Kudos
Reply