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

How to define an operator for a self-defined type data

Port__Phillip
Beginner
861 Views

Hi, everyone:

I would like to define an adding operator for a self-defined type data structure named "test_class"

Its defination is listed below

module test_class
implicit none

type vector
    integer n1
    real*8, allocatable :: v (:)
end type vector

interface operator (+)
    module procedure add
end interface

contains

function add (a1, a2)
implicit none
type (vector) add
type (vector), intent (in) :: a1, a2

add%v = a1%v+ a2%v

end function add

end module test_class

And the main program part is

program test1

use test_class

implicit none

type (vector) a1, a2, a3

a1%n1 = 3
a2%n1 = 3
a3%n1 = 3
allocate (a1%v(a1%n1), a2%v(a2%n1), a3%v(a3%n1))
a1%v = 3.0d0
write (*,*) a1%n1, a1%v

a2%v = 2.0d0
a3%v = 3.0d0
a1 = a2+ a3

write (*,*) a1%n1, a1%v

end program test1

The output could sometime go wrong, with a1%n1 alternated and segmentation error is reported.

What is the problem? How to define an operator in Fortran for a type data structure?

0 Kudos
1 Solution
FortranFan
Honored Contributor II
861 Views

You may want to review references in this Dr Fortran blog: https://software.intel.com/en-us/blogs/2013/12/30/doctor-fortran-in-its-a-modern-fortran-world

specifically the sections of kind and length-type parameters, parameterized derived types (PDTs), type-bound procedures, modern Fortran style and usage, and so forth.

Since a PDT attempt caused an 'internal compiler error (ICE)', here's a sample with an allocatable component along the lines of what you show in the original post you can review:

module mykinds_m

   use, intrinsic :: iso_fortran_env, only : WP => real64

   implicit none

end module mykinds_m
module test_class

   use mykinds_m, only : WP

   implicit none

   type :: vector
      integer :: n1
      real(kind=WP), allocatable :: v(:)
   contains
      private
      procedure, pass(a1)  :: add_vector
      generic, public :: operator(+) => add_vector
   end type vector

contains

   function add_vector(a1, a2) result( sum_v )

      class(vector), intent(in) :: a1
      type(vector), intent(in)  :: a2
      !.. Function result
      type(vector) :: sum_v

      if ( a1%n1 == a2%n1 ) then
         sum_v%n1 = a1%n1
         sum_v%v = a1%v+ a2%v
      else
         ! appropriate action elided: error stop?
      end if

      return

   end function add_vector

end module test_class
program test1

   use mykinds_m, only : WP
   use test_class, only : vector

   implicit none

   type(vector) :: a1, a2, a3

   a1%n1 = 3
   a2%n1 = 3
   a3%n1 = 3
   allocate (a1%v(a1%n1), a2%v(a2%n1), a3%v(a3%n1))
   a1%v = 3.0_wp
   write (*,*) a1%n1, a1%v

   a2%v = 2.0_wp
   a3%v = 3.0_wp
   a1 = a2 + a3

   write (*,*) a1%n1, a1%v

   stop

end program test1

Upon execution with Intel Fortran,

 3 3.00000000000000 3.00000000000000 3.00000000000000
 3 5.00000000000000 5.00000000000000 5.00000000000000

 

View solution in original post

0 Kudos
9 Replies
FortranFan
Honored Contributor II
862 Views

You may want to review references in this Dr Fortran blog: https://software.intel.com/en-us/blogs/2013/12/30/doctor-fortran-in-its-a-modern-fortran-world

specifically the sections of kind and length-type parameters, parameterized derived types (PDTs), type-bound procedures, modern Fortran style and usage, and so forth.

Since a PDT attempt caused an 'internal compiler error (ICE)', here's a sample with an allocatable component along the lines of what you show in the original post you can review:

module mykinds_m

   use, intrinsic :: iso_fortran_env, only : WP => real64

   implicit none

end module mykinds_m
module test_class

   use mykinds_m, only : WP

   implicit none

   type :: vector
      integer :: n1
      real(kind=WP), allocatable :: v(:)
   contains
      private
      procedure, pass(a1)  :: add_vector
      generic, public :: operator(+) => add_vector
   end type vector

contains

   function add_vector(a1, a2) result( sum_v )

      class(vector), intent(in) :: a1
      type(vector), intent(in)  :: a2
      !.. Function result
      type(vector) :: sum_v

      if ( a1%n1 == a2%n1 ) then
         sum_v%n1 = a1%n1
         sum_v%v = a1%v+ a2%v
      else
         ! appropriate action elided: error stop?
      end if

      return

   end function add_vector

end module test_class
program test1

   use mykinds_m, only : WP
   use test_class, only : vector

   implicit none

   type(vector) :: a1, a2, a3

   a1%n1 = 3
   a2%n1 = 3
   a3%n1 = 3
   allocate (a1%v(a1%n1), a2%v(a2%n1), a3%v(a3%n1))
   a1%v = 3.0_wp
   write (*,*) a1%n1, a1%v

   a2%v = 2.0_wp
   a3%v = 3.0_wp
   a1 = a2 + a3

   write (*,*) a1%n1, a1%v

   stop

end program test1

Upon execution with Intel Fortran,

 3 3.00000000000000 3.00000000000000 3.00000000000000
 3 5.00000000000000 5.00000000000000 5.00000000000000

 

0 Kudos
Port__Phillip
Beginner
861 Views

Thank you for your kindly reply.

I have tried the codes.

But it seems can not be compiled with the error:

error #6355: This binary operation is invalid for this data type.   [A2]
error #6355: This binary operation is invalid for this data type.   [A3]
error #6549: An arithmetic or LOGICAL type is required in this context.

The error is pointing to the 19th line in the file for program test1.

The compiling enviroment is Windows 10 with Microsoft Visual studio and Intel Fortran compiler.

How can I fix it?

0 Kudos
FortranFan
Honored Contributor II
861 Views

Checked whether the test_class module was recompiled with the code in Message #2 and the updated mod file is use'd when the main program is being compiled.

By the way, you may want to use the Intel Fortran Windows forum given your Windows 10 OS and Visual Studio environment; this forum is for Linux and Mac OS.

0 Kudos
Steven_L_Intel1
Employee
861 Views

Philip, I tried FortranFan's example and it compiled and ran fine. 

FortranFan, would you please attach the PDT version that got you an ICE?

0 Kudos
FortranFan
Honored Contributor II
861 Views

Steve Lionel (Intel) wrote:

.. FortranFan, would you please attach the PDT version that got you an ICE?

Steve,

Here it is:

module mykinds_m

   use, intrinsic :: iso_fortran_env, only : WP => real64

   implicit none

end module mykinds_m
module test_class

   use mykinds_m, only : WP

   implicit none

   type :: vector(n1)
      integer, len :: n1
      real(kind=WP) :: v(n1)
   contains
      private
      procedure, pass(a1)  :: add_vector
      generic, public :: operator(+) => add_vector
   end type vector

contains

   function add_vector(a1, a2) result( sum_v )

      class(vector(n1=*)), intent(in)    :: a1
      type(vector(n1=a1%n1)), intent(in) :: a2
      !.. Function result
      type(vector(n1=a1%n1)) :: sum_v

      sum_v%v = a1%v + a2%v

      return

   end function add_vector

end module test_class
program test1

   use mykinds_m, only : WP
   use test_class, only : vector

   implicit none

   type(vector(n1=3)) :: a1, a2, a3

   a1%v = 3.0_wp
   write (*,*) a1%n1, a1%v

   a2%v = 2.0_wp
   a3%v = 3.0_wp
   a1 = a2 + a3

   write (*,*) a1%n1, a1%v

   stop

end program test1

Compilation details:

C:\..>ifort /c /standard-semantics /warn:all /stand mykinds.f90
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R
) 64, Version 17.0.1.143 Build 20161005
Copyright (C) 1985-2016 Intel Corporation.  All rights reserved.


C:\..>ifort /c /standard-semantics /warn:all /stand test_class.f90
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R
) 64, Version 17.0.1.143 Build 20161005
Copyright (C) 1985-2016 Intel Corporation.  All rights reserved.


C:\..>ifort /c /standard-semantics /warn:all /stand test1.f90
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R
) 64, Version 17.0.1.143 Build 20161005
Copyright (C) 1985-2016 Intel Corporation.  All rights reserved.

010101_14277

catastrophic error: **Internal compiler error: internal abort** Please report th
is error along with the circumstances in which it occurred in a Software Problem
 Report.  Note: File and line given may not be explicit cause of this error.
compilation aborted for test1.f90 (code 1)

 

0 Kudos
Port__Phillip
Beginner
861 Views

Thank FtranFan adn Mr. Lionel for your time and kindly reply

0 Kudos
FortranFan
Honored Contributor II
861 Views

@Phillip P.,

By the way, if your code design for 'vector' and n1 variable implies dimensions and if there is a fixed small set you are planning to work with, as in 1-D, 2-D, 3-D, etc., then you may want to look into 'kind type parameters' as I mention in Message #2.  With PDTs, it is easier for implementations to get the kind type working and you can then have efficient and expressive code working without an ICE in Intel Fortran as follows:

module test_class

   use mykinds_m, only : WP

   implicit none

   type :: vector(n1)
      integer, kind :: n1
      real(kind=WP) :: v(n1)
   contains
      private
      procedure, pass(a1)  :: add_vector_1
      procedure, pass(a1)  :: add_vector_2
      procedure, pass(a1)  :: add_vector_3
      generic, public :: operator(+) => add_vector_1, add_vector_2, add_vector_3 
   end type vector

contains

   function add_vector_1(a1, a2) result( sum_v )

      class(vector(n1=1)), intent(in) :: a1
      
      include 'add.f90'

   end function add_vector_1

   function add_vector_2(a1, a2) result( sum_v )

      class(vector(n1=2)), intent(in) :: a1
      
      include 'add.f90'

   end function add_vector_2

   function add_vector_3(a1, a2) result( sum_v )

      class(vector(n1=3)), intent(in) :: a1
      
      include 'add.f90'

   end function add_vector_3

end module test_class

include file 'add.f90'

      type(vector(n1=a1%n1)), intent(in) :: a2
      !.. Function result
      type(vector(n1=a1%n1)) :: sum_v

      sum_v%v = a1%v + a2%v

      return
program test1

   use mykinds_m, only : WP
   use test_class, only : vector

   implicit none

   type(vector(n1=3)) :: a1
   type(vector(n1=3)) :: a2
   type(vector(n1=3)) :: a3

   a1%v = 3.0_wp
   write (*,*) "a1%n1 = ", a1%n1, ", a1%v = ", a1%v

   a2%v = 2.0_wp
   write (*,*) "a2%n1 = ", a2%n1, ", a2%v = ", a2%v

   a3%v = 3.0_wp
   write (*,*) "a3%n1 = ", a3%n1, ", a3%v = ", a3%v

   !..
   a1 = a2 + a3
   write (*,*) " after addition:"
   write (*,*) "a1%n1 = ", a1%n1, ", a1%v = ", a1%v

   blk: block  ! uncomment the two lines below and see what happens!
      !type(vector(n1=1)) :: b1
      !b1 = a2 + a3
   end block blk
   
   stop

end program test1
 a1%n1 =  3 , a1%v =  3.00000000000000 3.00000000000000
 3.00000000000000
 a2%n1 =  3 , a2%v =  2.00000000000000 2.00000000000000
 2.00000000000000
 a3%n1 =  3 , a3%v =  3.00000000000000 3.00000000000000
 3.00000000000000
  after addition:
 a1%n1 =  3 , a1%v =  5.00000000000000 5.00000000000000
 5.00000000000000

 

0 Kudos
Steven_L_Intel1
Employee
861 Views

FortranFan, thanks for the ICE example. I can reproduce this in 17.0.1 but not in our internal builds for the next update, so perhaps it has been fixed.

0 Kudos
Port__Phillip
Beginner
861 Views

Thank you FortranFan for your recently example.

It helps me a lot to further simplify my code.

0 Kudos
Reply