I am learning oop in fortran.
This is my code and the output surprise me :
module my_module
implicit none
type basic_t
real :: basic
end type basic_t
type, extends(basic_t) :: extended_t
real :: extended
end type extended_t
interface print_type
module procedure print_basic_type
module procedure print_extended_type
end interface print_type
contains
subroutine print_basic_type(basic)
type(basic_t), intent(in) :: basic
print *, 'in sub : print_basic_type'
end subroutine print_basic_type
subroutine print_extended_type(extended)
type(extended_t), intent(in) :: extended
print *, 'in sub : print_extended_type'
end subroutine print_extended_type
subroutine print_using_class(basic_or_extended)
class(basic_t), intent(in) :: basic_or_extended
select type (basic_or_extended)
type is (basic_t)
print *, 'the type is basic'
type is (extended_t)
print *, 'the type is extended'
end select
call print_type(basic_or_extended)
end subroutine print_using_class
end module my_module
program main
use my_module
type(basic_t) :: basic
type(extended_t) :: extended
call print_type(basic)
call print_type(extended)
print *,'------'
call print_using_class(basic)
print *,'------'
call print_using_class(extended)
end program main
This is the output :
in sub : print_basic_type
in sub : print_extended_type
------
the type is basic
in sub : print_basic_type
------
the type is extended
in sub : print_basic_type
When I use the interface print_type directly, it works. But when I call the subroutine print_using_class, it does not work for the extended type although the type is well recognized (cf select type before print_type call in subroutine print_using_class).
Is it the output expected ? And why ?
Thanks for answer.
Edit 1
As suggested in the comments, I should use "bindings". After many attempts, this is my new code.
module my_module
implicit none
type, abstract :: abstract_t
contains
procedure(print_abstract_t), deferred :: print_sub
end type abstract_t
abstract interface
subroutine print_abstract_t(this)
import abstract_t
class(abstract_t), intent(in) :: this
end subroutine print_abstract_t
end interface
type, extends(abstract_t) :: basic_t
real :: basic
contains
procedure :: print_sub => print_basic_type
end type basic_t
type, extends(basic_t) :: extended_t
real :: extended
contains
procedure :: print_sub => print_extended_type
end type extended_t
contains
subroutine print_basic_type(this)
class(basic_t), intent(in) :: this
print *, 'in sub : print_basic_type'
end subroutine print_basic_type
subroutine print_extended_type(this)
class(extended_t), intent(in) :: this
print *, 'in sub : print_extended_type'
end subroutine print_extended_type
subroutine print_using_class(basic_or_extended)
class(basic_t), intent(in) :: basic_or_extended
select type (basic_or_extended)
type is (basic_t)
print *, 'the type is basic'
type is (extended_t)
print *, 'the type is extended'
end select
call basic_or_extended%print_sub()
end subroutine print_using_class
end module my_module
program main
use my_module
type(basic_t) :: basic
type(extended_t) :: extended
call basic%print_sub()
call extended%print_sub()
print *,'------'
call print_using_class(basic)
print *,'------'
call print_using_class(extended)
end program main
I am surprised but it works. As I am learning OOP in fortran, any criticism would be appreciated.
In the subroutine print_using_class there is a reference to the generic print_type with actual argument basic_or_extended.
The generic print_type has two specific interfaces, print_basic_type and print_extended_type. (Because these specific procedures use non-polymorphic arguments they are not ambiguous (Fortran 2018, 15.4.3.4.5).) In the reference to the generic, we need to resolve the reference to a specific procedure. (F2018, 15.5.5.2)
Resolution to which of these two specific procedures is referenced is not based on dynamic type; resolution is based on declared type.
Why?
The relevant dummy arguments are:
type(basic_t) in print_basic_type
type(extended_t) in print_extended_type
The referenced specific procedure is the one where the dummy argument is type compatible with class(basic_or_extended) (F2018, 15.5.2.4). (Recall, only one specific can be consistently referenced.)
type(basic_t) is type compatible with class(basic_t); type(extended_t) is not (F2018, 7.3.2.3 p.5). The reference to the generic print_type is always to print_basic_type. (Note that a class(basic_t) is type compatible with a type(extended_t) but we need the dummy to be type compatible with the actual, not the actual to be type compatible with the dummy: type compatability is not symmetric. )
If you want to use a generic and resolve to the dynamic type of the actual argument, well you can't. What you can do is have another object of the desired declared type:
subroutine print_using_class(basic_or_extended)
class(basic_t), intent(in) :: basic_or_extended
select type (basic_or_extended)
type is (basic_t)
print *, 'the type is basic'
call print_type(basic_or_extended)
type is (extended_t)
print *, 'the type is extended'
call print_type(basic_or_extended)
end select
end subroutine print_using_class
But ideally, you wouldn't be doing this. Instead, you'll be using bindings and type-bound procedures where this dynamic resolution just falls out.
Related
Again I might have a weird question about how I would (or could) use types in Fortran.
Basically, what I hhave so far is an abstract type AbsBase with han interface. I can now extend this type multiple times bby defining Child types where I have different definitions of sub like so
Working example
Base Module
module BaseClass
implicit none
type, abstract :: AbsBase
contains
procedure(subInt), nopass, deferred :: sub
end type
interface
subroutine subInt
implicit none
end subroutine subInt
end interface
end module BaseClass
Child Molude 1
module ChildClass1
use BaseClass
implicit noone
type, extends(AbsBase) :: Child1
contains
procedure, nopass :: sub
end type
contains
subroutine sub
implicit none
print*, "Do something ..."
end sub
end module ChildClass1
Child Molude 2
module ChildClass2
use BaseClass
implicit noone
type, extends(AbsBase) :: Child2
contains
procedure, nopass :: sub
end type
contains
subroutine sub
implicit none
print*, "Do something else ..."
end sub
end module ChildClass2
Program
program test
use ChhildClass1
use ChhildClass2
implicit none
type(Child1) :: c1
type(Child2) :: c2
call c1%sub ! <-- prints "Do something ... "
call c2%sub ! <-- prints "Do somethhing else ..."
end program test
So far so good but what if I want to define an array of a type instead of having 2 different Child types? I have tried the following
Non-working example (what I try to do)
Base Module
module BaseClass
implicit none
type, abstract :: AbsBase
contains
procedure(subInt), nopass, deferred :: sub
end type
interface
subroutine subInt
implicit none
end subroutine subInt
end interface
type :: BaseWrap
class(AbsBase), pointer :: p
end type
end module BaseClass
Program
program test
use BaseClass
implicit none
type(BaseWrap) :: Child(2)
call Child(1)%p%sub ! <--- This should produce "Do something ..."
call Child(2)%p%sub ! <--- This should produce "Do something else ..."
contains
! Where to I define the subroutines and how would I do this?
end module ChildClass
It actually compiles (which was quite surprising for me) but obviously results in a Segmentation Fault as I have nowhere defined the subroutines. If I understand right then I got with type(BaseWrap) :: Child(2) an array of pointers which point to the interface of the abstract type AbsBase. How would I now define the two subroutines from the working example? Is that even possible?
Thanks!
Well, the classes your created are just enough to have the polymorphic behaviour you seem to be looking for. You can test it like this:
program test
use :: BaseClass
implicit none
type(Child1), target :: c1
type(Child2), target :: c2
type(BaseWrap) :: child(2)
child(1)%p => c1
child(2)%p => c2
call child(1)%p%sub ! <-- prints "Do something ... "
call child(2)%p%sub ! <-- prints "Do somethhing else ..."
end
But using an allocatable element instead of pointer would remove the necesity of target attributes, among other advantages.
Your design is good when those subroutines are somehow tight to the types, us their data and so on. You just need to define the pointers as Rodrigo showed. If those subroutines do not actually depend on any external type and the Child types are actually just made to hold a different procedure each, you don't need such a complex construction. You can just store the procedure pointers in a single type.
module subs
implicit none
contains
subroutine sub1
print*, "Do something ..."
end subroutine
subroutine sub2
print*, "Do something else ..."
end subroutine
end module
use subs
type sub_wrap
procedure(sub1), pointer, nopass :: sub
end type
type(sub_wrap) :: a(2)
!one way
a = [sub_wrap(sub1), sub_wrap(sub2)]
!another way
! a(1)%sub => sub1
! a(2)%sub => sub2
call a(1)%sub()
call a(2)%sub()
end
I can't figure out how I define a simple constructor for a class. What I want to do is allocate an array in mytype and later populate it in the main program.
What I have is this:
module types
implicit none
type mytype
real, allocatable :: someArray(:)
end type mytype
interface
module procedure :: init
end interface
contains
subroutine init(this)
class(mytype), intent(inout) :: this
allocate( this%someArray(5) )
end subroutine init
end module types
program test
use types
implicit none
type(mytype) :: array
call array%init
do i=1, 5
array%someArray(i) = real(i)
print *, array%someArray(i)
end do
end program test
When I compile I get the error
Error: MODULE PROCEDURE at (1) must be in a generic module interface
What does that mean? How can I define a generic module interface?
Thanks!
The language's model for a user provided constructor is a generic function with the same identifier as the type, that simply returns an object of the type. Beyond the ability to have a generic with the same name as a type, this is nothing special.
module types
implicit none
type mytype
real, allocatable :: someArray(:)
end type mytype
interface mytype
module procedure :: init
end interface
! init would typically be private.
contains
function init()
type(mytype) :: this
allocate( this%someArray(5) )
! Non-pointer function result must be defined.
this%someArray = 0
end function init
end module types
program test
use types
implicit none
type(mytype) :: x
x = mytype()
do i=1, 5
x%someArray(i) = real(i)
print *, x%someArray(i)
end do
end program test
(The example is somewhat pointless given other aspects of the language, such as parameterized types, array constructors, automatic allocation or even the out-of-the-box capability of the built-in structure constructors.)
The error message from the compiler perhaps means to reference a generic interface, as a procedure statement is only permitted in an interface block for a generic.
Specific type bound procedure references - things with the syntax object % binding - are generally used when you have a parent type that has a method with a particular signature (set of dummy arguments, bar the passed argument), and you want to override that method in extensions - i.e. invoke a different procedure that has the same signature. Constructors don't fit this - typically the information that needs to be passed to a constructor (i.e. the signature of the call) is type specific.
I explain my question in the form of an example.
I have a type (location2d_t) which includes two members x, and y and a type-bound procedure (calcdist2d). The procedure, in addition of (this) with class of (location2d_t), accepts its own type (as second dummy argument) to calculate a distance.
Now, I go further and extend the type to (location3d_t) which has z as well.
To re-define the procedure, I cannot override the previous one so I create a new procedure (calcdist3d) with the second argument of type of (location3d_t) and make a generic procedure (calcdist) for them. In other words, second arguments have different types so generic idea is applicable.
In a more general scope, let's say main program here, for the sake of generality I declare my object as class of parent. When I allocate the object with type of child (location3d_t), a call to (calcdist) whose second dummy argument is (location3d_t) refers to parent generic and says
Error: Found no matching specific binding for the call to the GENERIC 'calcdist'
The code is
module point_mod
implicit none
type location2d_t
integer :: x,y
contains
procedure :: calcdist2d => calcdistance2d
procedure :: here => here_location2d
generic :: calcdist => calcdist2d
end type
type, extends(location2d_t) :: location3d_t
integer :: z
contains
procedure :: calcdist3d => calcdistance3d
procedure, public :: here => here_location3d
generic, public :: calcdist => calcdist3d
end type
contains
function calcdistance2d(this,location) result(output)
class(location2d_t) :: this
type(location2d_t) :: location
integer :: output
output = int(sqrt(real((location%x-this%x)**2+(location%y-this%y)**2)))
end function
function calcdistance3d(this,location) result(output)
class(location3d_t) :: this
type(location3d_t) :: location
integer :: output
output = int(sqrt(real((location%x-this%x)**2+ &
(location%y-this%y)**2+(location%z-this%z)**2)))
end function
subroutine here_location2d(this)
class (location2d_t) :: this
print*, "we are in locationd2d_t"
end subroutine
subroutine here_location3d(this)
class (location3d_t) :: this
print*, "we are in locationd3d_t"
end subroutine
end module
The module is compiled without any error. The below program is implemented to use the module:
program main
use point_mod
implicit none
class (location2d_t), allocatable :: loc
type (location3d_t) :: dum
allocate(location2d_t::loc)
call loc%here() ! calls location2d_t procedure
deallocate(loc)
allocate(location3d_t::loc)
call loc%here() !correctly calls procedure of location3d_t
print*,loc%calcdist(dum) ! gives error
select type (loc)
type is (location3d_t)
print*,loc%calcdist(dum) ! runs well
end select
end program
The procedure "Here" finds its dynamic type correctly. Why isn't generic procedure of child (calcdist) explicitly called ? Do I have to use "select type" block always even in this obvious case?
N.B.: I checked the code with GNU fortran 4.8 and 4.9, and ifort 14.
Yes, you have to use "select type". Outside the "type is" block, loc is polymorphic. Only inside type is (location3d_t), loc has a type and can be passed as dummy argument with defined type.
Generic procedures are always not overridden when the type is extended, so in location3d_t, calcdist is the generic binding for calcdist3d and calcdist2d and loc needs a specific type when calling calcdist to find the appropriate procedure.
When location2d_t is extended, to location3d_t, here binding is overriden and there is only one procedure associated to loc%here() so can be called outside the "type is" block
You can accomplish this behavior without generics with only a slight tweak to your calcdistanceXd functions. The reason you couldn't override the function in your extended type is that the argument type of location was mismatched. If you instead declare location in calcdistance2d to be class(location2d_t) then you can match this in calcdistance3d. You will have to add in a select type construct into calcdistance3d in order to access the members of location3d_t from the polymorphic variable location.
Example:
module point_mod
implicit none
type :: location2d_t
integer :: x, y
contains
procedure, public, pass(this) :: calcdist => calcdistance2d
procedure, public, pass(this) :: here => here_location2d
end type
type, extends(location2d_t) :: location3d_t
integer :: z
contains
procedure, public, pass(this) :: calcdist => calcdistance3d
procedure, public, pass(this) :: here => here_location3d
end type
contains
function calcdistance2d(this, location) result(output)
class(location2d_t) :: this
class(location2d_t) :: location
integer :: output
output = int(sqrt(real((location%x-this%x)**2+(location%y-this%y)**2)))
end function
function calcdistance3d(this,location) result(output)
class(location3d_t) :: this
class(location2d_t) :: location
integer :: output
select type (location)
type is (location3d_t)
output = int(sqrt(real((location%x-this%x)**2+ &
(location%y-this%y)**2+(location%z-this%z)**2)))
class default
output = -1
end select
end function
subroutine here_location2d(this)
class (location2d_t) :: this
print*, "we are in locationd2d_t"
end subroutine
subroutine here_location3d(this)
class (location3d_t) :: this
print*, "we are in locationd3d_t"
end subroutine
end module
With this version of point_mod, your example program works:
program main
use point_mod
implicit none
class (location2d_t), allocatable :: loc
type (location3d_t) :: dum
allocate(location2d_t::loc)
call loc%here() ! calls location2d_t procedure
deallocate(loc)
allocate(location3d_t::loc)
call loc%here() !correctly calls procedure of location3d_t
print*,loc%calcdist(dum)
end program
It is true this approach still requires a select type, but it is hidden in the module implementation rather than being required by users of the module.
I have a question regarding assigning Fortran90 derived types and pointers at runtime. I want to pass a derived variable type to a subroutine after the code reads an input file. So depending on the input I pass the appropriate data type. Let me explain:
I have two modules:
Module A_mod and Module B_mod. Each has it's own unique data type and subroutines. For example:
Module A_mod
type A
real :: x, y
end type
contains
subroutine FunA(me)
type (A), intent(in) :: me
<do stuff>
end subroutine
End module A_mod
Module B_mod is a mirror of the above with B replacing A (also the data type B has x and y defined as integers).
I also have a third module that has this interface:
interface fun
modular procedure funA, funB
end interface
Here is my problem. The user via an input file determines which module subroutine to use. How can I make a generic pointer that gets associated at runtime? Or something similar that doesn't require pointers.
For example:
type (?) :: pt
Call fun(pt)
where after the program reads the input file it picks the correct data type to be sent to the interfaced subroutine "fun". So the type is unknown until runtime.
If Fortran would let me declare a variable in my execution portion of code it would look like this for example
IF(input.EQ."A") THEN
type(A) :: pt
ELSE
type(B) :: pt
END IF
CALL fun(pt)
Any suggestion would be appreciated !!
Thank you
This is difficult to do cleanly in Fortran 90. It is straight forward in Fortran 2003.
Resolution of the procedure to call when the generic reference fun is encountered (in CALL fun(pt)) is done at compile time, based on the declared type of pt.
If you are limited to Fortran 90, then effectively you will need to maintain a flag of some sort that indicates at runtime which particular derived type you want to work with, have a named object for each of type A and type B, and everytime you want to reference fun have an IF construct that selects the correctly named argument.
(If the size of the objects is significant you can arrange for them to have common storage.)
Something like:
TYPE(A) :: pt_A
TYPE(B) :: pt_B
...
IF (input .EQ. 'A') THEN
CALL fun(pt_A)
ELSE
CALL fun(pt_B)
END IF
In F2003, you would define a common parent type, that had a specific binding named fun. pt would then be a polymorphic allocatable object, allocated based on input to either type A or type B as appropriate.
TYPE :: Parent
CONTAINS
PROCEDURE(parent_Fun), DEFERRED :: Fun
END TYPE Parent
ABSTRACT INTERFACE
SUBROUTINE parent_Fun(obj)
IMPORT :: Parent
IMPLICIT NONE
CLASS(Parent), INTENT(IN) :: obj
END SUBROUTINE parent_Fun
END INTERFACE
TYPE, EXTENDS(Parent) :: A
REAL :: x, y
CONTAINS
PROCEDURE :: A => A_Fun
END TYPE A
TYPE, EXTENDS(Parent) :: B
INTEGER :: x, y
CONTAINS
PROCEDURE :: B => B_Fun
END TYPE B
CLASS(Parent), ALLOCATABLE :: pt
...
IF (input .EQ. 'A') THEN
ALLOCATE(A:: pt)
ELSE
ALLOCATE(B:: pt)
END IF
...
CALL pt%Fun()
I am writing a library for importing geometries of many types (spheres,planes,NURBS surfaces, stl files...) into a scientific Fortran code. This kind of problem seems taylor-made for OOP because it is simple to define a type :: geom and then type,extends(geom) :: analytic and so on. The part I am having trouble with is the file IO.
My solution at this point is to write the parameters defining the shapes, including some flags which tell me which shape it is. When reading, I instantiate a class(geom) :: object, (since I don't know ahead of time which subtype it will be) but how can I read it?
I can't access any of the specific components of the subtype. I read that downcasting is verboten, and besides, the new allocate(subtype :: class) doesn't seem to work. The new READ(FORMATTED) doesn't seem to be implemented by ifort or gfortran. i.e.
module geom_mod
type :: geom
end type
type,extends(geom) :: sphere
integer :: type
real(8) :: center(3),radius
contains
generic :: READ(FORMATTED)=> read_sphere ! not implemented anywhere
end type
contains
subroutine read_geom(object)
class(geom),intent(out),pointer :: object
integer :: type
read(10,*) object%type ! can't access the subtype data yet
read(10,*) type
backspace(10)
if(type==1) then
allocate(sphere :: object)! downcast?
read(10,*) object ! doesn't work
end if
end read_geom
end module
Am I going about this all wrong? I could hack this using something other than polymorphism, but this seems cleaner everywhere else. Assistance would be greatly appreciated.
EDIT: sample program using IanH's module
program test
use geom_mod
implicit none
class(geom),allocatable :: object
open(10)
write(10,*) '1'
write(10,*) sphere(center=0,radius=1)
rewind(10)
call read(object) ! works !
end program test
Current gfortran and ifort do not implement defined input/output. I have not seen any evidence that this situation will change in the near future. However, apart from allowing some syntactic shortcuts that feature does not actually save you much work here.
One approach for this situation is to call a "factory" for extensions of geom that uses the data in the file to allocate the argument to the correct type, then hand off to a type bound procedure that reads in the type specific data. For example:
module geom_mod
implicit none
integer, parameter :: dp = kind(1.0d0)
type, abstract :: geom
contains
procedure(read_geom), deferred :: read
end type geom
abstract interface
subroutine read_geom(object)
import :: geom
implicit none
class(geom), intent(out) :: object
end subroutine read_geom
end interface
type, extends(geom) :: sphere
real(dp) :: center(3), radius
contains
procedure :: read => read_sphere
end type sphere
contains
subroutine read(object)
class(geom), intent(out), allocatable :: object
integer :: type
read (10, *) type
! Create (and set the dynamic type of object) based on type.
select case (type)
case (1) ; allocate(sphere :: object)
case default ; stop 'Unsupported type index'
end select
call object%read
end subroutine read
subroutine read_sphere(object)
class(sphere), intent(out) :: object
read (10, *) object%center, object%radius
end subroutine read_sphere
end module geom_mod
Current ifort (12.1.5) has issues with intent(out) polymorphic arguments that may require workarounds, but the general approach remains the same.
(Note that the subroutine read is not a type bound subroutine - to read a generic geom object use ''call read(object)'' in the conventional subroutine reference style.)