I take an example from "Fortran 95/2003 explained" by Metcalf et al, since m own code aims for the same thing.
type, abstract :: my_numeric_type
contains
private
procedure(op2), deferred :: add
generic, public :: operator(+) => add
end type
abstract interface
function op2(a,b) result (r)
import :: my_numeric_type
class(my_numeric type), intent(in) :: a,b
class(my_numeric type), allocatable :: r
end function op2
end interface
type, extends(my_numeric_type) :: my_integer
integer, private :: value
contains
procedure :: add => add_my_integer
end type
Now, my question is how do I properly implement the add_my_integer
function. It seems like I am forced to cast the first argument as my_integer
since it is a type bound procedure, but the second one has to be my_numeric_type
to be compliant with the abstract interface. As for the result, should I allocate r
to my_integer
? here is what I came up with so far, it does compile, but it seems weird to check for type all the time, and it causes a segmentation fault (perhaps due to some other problem with my code though).
function add_my_integer(a,b) result(r)
class(my_integer), intent(in) :: a
class(my_numeric_type), intent(in) :: b
class(my_numeric_type), allocatable :: r
allocate(my_integer :: r)
select type (b)
type is (my_integer)
r = a+b
end select
end function
This works for me, but it looks quite complicated (too many select type
). I made the value public for easy output only, otherwise you want a custom getter and setter.
module num
type, abstract :: my_numeric_type
contains
private
procedure(op2), deferred :: add
generic, public :: operator(+) => add
procedure(op), deferred :: ass
generic, public :: assignment(=) => ass
end type
abstract interface
subroutine op(a,b)
import :: my_numeric_type
class(my_numeric_type), intent(out) :: a
class(my_numeric_type), intent(in) :: b
end subroutine op
function op2(a,b) result (r)
import :: my_numeric_type
class(my_numeric_type), intent(in) :: a,b
class(my_numeric_type), allocatable :: r
end function op2
end interface
type, extends(my_numeric_type) :: my_integer
integer, public :: value
contains
procedure :: add => add_my_integer
procedure :: ass => ass_my_integer
end type
contains
function add_my_integer(a,b) result(r)
class(my_integer), intent(in) :: a
class(my_numeric_type), intent(in) :: b
class(my_numeric_type), allocatable :: r
select type (b)
type is (my_integer)
allocate(my_integer :: r)
select type (r)
type is (my_integer)
r%value = a%value+b%value
end select
end select
end function
subroutine ass_my_integer(a,b)
class(my_integer), intent(out) :: a
class(my_numeric_type), intent(in) :: b
select type (b)
type is (my_integer)
a%value = b%value
end select
end subroutine
end module
program main
use num
class(my_integer), allocatable :: a, b, c
allocate(my_integer :: a)
allocate(my_integer :: b)
allocate(my_integer :: c)
a=my_integer(1)
b=my_integer(2)
c = a+b
write (*,*) c%value
end program
Polymorphism has its costs to efficiency - Vladimir F 2012-04-06 06:47