OOP fortran : Must I keep the abstract interface in this program? - oop

Following the second option suggested by Federico Perini in Fortran : Is it possible to overload a procedure in a abstract interface?, I wrote this code.
module myModule
implicit none
type, abstract :: shape_t
contains
! Put init in a generic interface
procedure(abstract_init), deferred, private :: shared_init
generic :: init => shared_init
procedure(abstract_print), deferred :: print_size
end type shape_t
abstract interface
subroutine abstract_init(this,length1,length2,length3)
import shape_t
class(shape_t), intent(inout) :: this
real, intent(in) :: length1,length2,length3
end subroutine abstract_init
subroutine abstract_print(this)
import shape_t
class(shape_t), intent(in) :: this
end subroutine abstract_print
end interface
type, extends(shape_t) :: line_t
real :: length
contains
procedure :: shared_init => init_line
procedure :: init_line_1d
generic :: init => init_line_1d
procedure :: print_size => print_linesize
end type line_t
type, extends(shape_t) :: rectangle_t
real :: length,width
contains
procedure :: shared_init => init_rectangle
procedure :: init_rectangle_2d
generic :: init => init_rectangle_2d
procedure :: print_size => print_rectanglesize
end type rectangle_t
type, extends(shape_t) :: box_t
real :: length,width,height
contains
procedure :: shared_init => init_box
procedure :: print_size => print_boxsize
end type box_t
contains
subroutine init_line_1d(this,length1)
class(line_t), intent(inout) :: this
real, intent(in) :: length1
this%length = length1
end subroutine init_line_1d
subroutine init_line(this,length1,length2,length3)
class(line_t), intent(inout) :: this
real, intent(in) :: length1,length2,length3
call init_line_1d(this,length1)
end subroutine init_line
subroutine print_linesize(this)
class(line_t), intent(in) :: this
print*,'Line size',this%length,'meter'
end subroutine print_linesize
subroutine init_rectangle(this,length1,length2,length3)
class(rectangle_t), intent(inout) :: this
real, intent(in) :: length1,length2,length3
call init_rectangle_2d(this,length1,length2)
end subroutine init_rectangle
subroutine init_rectangle_2d(this,length1,length2)
class(rectangle_t), intent(inout) :: this
real, intent(in) :: length1,length2
this%length = length1
this%width = length2
end subroutine init_rectangle_2d
subroutine print_rectanglesize(this)
class(rectangle_t), intent(in) :: this
print*,'Rectangle area',this%length*this%width,'meter^2'
end subroutine print_rectanglesize
subroutine init_box(this,length1,length2,length3)
class(box_t), intent(inout) :: this
real, intent(in) :: length1,length2,length3
this%length = length1
this%width = length2
this%height = length3
end subroutine init_box
subroutine print_boxsize(this)
class(box_t), intent(in) :: this
print*,'Box volume',this%length*this%width*this%height,'meter^3'
end subroutine print_boxsize
end module myModule
program main
use myModule
implicit none
class(shape_t), allocatable :: dynamic_typing
integer :: choice
print *,'choice (1:line, 2:rectangle or 3:box)'
read(*,'(i1)') choice
select case (choice)
case(1)
allocate(line_t::dynamic_typing)
case(2)
allocate(rectangle_t::dynamic_typing)
case(3)
allocate(box_t::dynamic_typing)
case default
print *,'not permitted'
stop
end select
select type (dynamic_typing)
type is (line_t)
call dynamic_typing%init(4.0)
call dynamic_typing%print_size()
type is (rectangle_t)
call dynamic_typing%init(4.0,3.0)
call dynamic_typing%print_size()
type is (box_t)
call dynamic_typing%init(4.0,3.0,2.0)
call dynamic_typing%print_size()
end select
end program main
But, shared_init in the abstract interface made me wonder. On one hand, it is useful because, an init procedure is mandatory in derived type. But, a subroutine (init_line, init_rectangle, init_box) not used must be written for each derived type. And as it contains all parameters, if a new derived type is added with another parameters (an integer, a logical, or whatever), the abstract interface must be changed and consequently all subroutines mentionned above. It seems me very difficult to maintain (but I am not an OOP specialist).
In first intention, I removed the deferred procedure abstract_init and I keep only procedure :: init_line_1d and generic :: init => init_line_1d (idem for rectangle and box) in the definition of the derived type. but in this case, init was not mandatory and it bothered me.
So, I have written the code below where it is mandatory to have an init procedure. But, this procedure is very short and has no parameter. And, new derived type could be easily added with new parameters, without changing code for the previous defined.
module myModule
implicit none
type, abstract :: shape_t
contains
! Put init in a generic interface
procedure(abstract_init), nopass, deferred, private :: shared_init
generic :: init => shared_init
procedure(abstract_print), deferred :: print_size
end type shape_t
abstract interface
subroutine abstract_init()
end subroutine abstract_init
subroutine abstract_print(this)
import shape_t
class(shape_t), intent(in) :: this
end subroutine abstract_print
end interface
type, extends(shape_t) :: line_t
real :: length
contains
procedure, nopass, private :: shared_init => init_line
procedure :: init_line_1d
generic :: init => init_line_1d
procedure :: print_size => print_linesize
end type line_t
type, extends(shape_t) :: rectangle_t
real :: length,width
contains
procedure, nopass, private :: shared_init => init_rectangle
procedure :: init_rectangle_2d
generic :: init => init_rectangle_2d
procedure :: print_size => print_rectanglesize
end type rectangle_t
type, extends(shape_t) :: box_t
real :: length,width,height
contains
procedure, nopass, private :: shared_init => init_box
procedure :: init_box_3d
generic :: init => init_box_3d
procedure :: print_size => print_boxsize
end type box_t
contains
subroutine init_line_1d(this,length1)
class(line_t), intent(inout) :: this
real, intent(in) :: length1
this%length = length1
end subroutine init_line_1d
subroutine print_linesize(this)
class(line_t), intent(in) :: this
print*,'Line size',this%length,'meter'
end subroutine print_linesize
subroutine init_rectangle_2d(this,length1,length2)
class(rectangle_t), intent(inout) :: this
real, intent(in) :: length1,length2
this%length = length1
this%width = length2
end subroutine init_rectangle_2d
subroutine print_rectanglesize(this)
class(rectangle_t), intent(in) :: this
print*,'Rectangle area',this%length*this%width,'meter^2'
end subroutine print_rectanglesize
subroutine init_box_3d(this,length1,length2,length3)
class(box_t), intent(inout) :: this
real, intent(in) :: length1,length2,length3
this%length = length1
this%width = length2
this%height = length3
end subroutine init_box_3d
subroutine print_boxsize(this)
class(box_t), intent(in) :: this
print*,'Box volume',this%length*this%width*this%height,'meter^3'
end subroutine print_boxsize
subroutine init_rectangle() ; end subroutine init_rectangle
subroutine init_line() ; end subroutine init_line
subroutine init_box() ; end subroutine init_box
end module myModule
But, as I am a beginner in OOP, I wonder if it is a good idea or totally stupid.
Thank for answer.

The reason abstract interfaces exist is to define a common template that all extended types need to comply to. In your example, you could have such interfaces to mandate properties that are shared across all them. For example (to name a couple):
abstract interface
elemental real(real64) function shape_area(this) result(A)
class(shape_t), intent(in) :: this
end function shape_area
elemental real(real64) function shape_perimeter(this) result(p2)
class(shape_t), intent(in) :: this
end function shape_perimeter
end interface
Initializers for different extended types clearly will never comply to that interface being always the same (otherwise, there would be no need to have a polymorphic class), so, some strategy needs to be put in place. For simple cases like yours, I think the most compact/easy/understandable thing to do is to use default type initializers:
select type (new)
type is (rectangle_t); new = rectangle_t(width,length)
type is (line_t); new = line_t(length)
type is (box_t); new = box_t(length,width,height)
class default; stop 'catastrophic error!'
end select
Otherwise, you need to have a factory that hides away all of the complexity in a separate module.

Related

OOP Fortran : Is it possible to avoid select type and call suboutine directly?

This question follows Fortran : Is it possible to overload a procedure in a abstract interface?.
Following the second option suggested by Federico Perini in its answer, I wrote the following code where a question is asked to the user to choose between line, rectangle or box.
module myModule
implicit none
type, abstract :: shape_t
contains
! Put init in a generic interface
procedure(abstract_init), deferred, private :: shared_init
generic :: init => shared_init
procedure(abstract_print), deferred :: print_size
end type shape_t
abstract interface
subroutine abstract_init(this,length1,length2,length3)
import shape_t
class(shape_t), intent(inout) :: this
real, intent(in) :: length1,length2,length3
end subroutine abstract_init
subroutine abstract_print(this)
import shape_t
class(shape_t), intent(in) :: this
end subroutine abstract_print
end interface
type, extends(shape_t) :: line_t
real :: length
contains
procedure :: shared_init => init_line
procedure :: init_line_1d
generic :: init => init_line_1d
procedure :: print_size => print_linesize
end type line_t
type, extends(shape_t) :: rectangle_t
real :: length,width
contains
procedure :: shared_init => init_rectangle
procedure :: init_rectangle_2d
generic :: init => init_rectangle_2d
procedure :: print_size => print_rectanglesize
end type rectangle_t
type, extends(shape_t) :: box_t
real :: length,width,height
contains
procedure :: shared_init => init_box
procedure :: print_size => print_boxsize
end type box_t
contains
subroutine init_line_1d(this,length1)
class(line_t), intent(inout) :: this
real, intent(in) :: length1
this%length = length1
end subroutine init_line_1d
subroutine init_line(this,length1,length2,length3)
class(line_t), intent(inout) :: this
real, intent(in) :: length1,length2,length3
call init_line_1d(this,length1)
end subroutine init_line
subroutine print_linesize(this)
class(line_t), intent(in) :: this
print*,'Line size',this%length,'meter'
end subroutine print_linesize
subroutine init_rectangle(this,length1,length2,length3)
class(rectangle_t), intent(inout) :: this
real, intent(in) :: length1,length2,length3
call init_rectangle_2d(this,length1,length2)
end subroutine init_rectangle
subroutine init_rectangle_2d(this,length1,length2)
class(rectangle_t), intent(inout) :: this
real, intent(in) :: length1,length2
this%length = length1
this%width = length2
end subroutine init_rectangle_2d
subroutine print_rectanglesize(this)
class(rectangle_t), intent(in) :: this
print*,'Rectangle area',this%length*this%width,'meter^2'
end subroutine print_rectanglesize
subroutine init_box(this,length1,length2,length3)
class(box_t), intent(inout) :: this
real, intent(in) :: length1,length2,length3
this%length = length1
this%width = length2
this%height = length3
end subroutine init_box
subroutine print_boxsize(this)
class(box_t), intent(in) :: this
print*,'Box volume',this%length*this%width*this%height,'meter^3'
end subroutine print_boxsize
end module myModule
program main
use myModule
implicit none
class(shape_t), allocatable :: dynamic_typing
integer :: choice
print *,'choice (1:line, 2:rectangle or 3:box)'
read(*,'(i1)') choice
select case (choice)
case(1)
allocate(line_t::dynamic_typing)
case(2)
allocate(rectangle_t::dynamic_typing)
case(3)
allocate(box_t::dynamic_typing)
case default
print *,'not permitted'
stop
end select
select type (dynamic_typing)
type is (line_t)
call dynamic_typing%init(4.0)
call dynamic_typing%print_size()
type is (rectangle_t)
call dynamic_typing%init(4.0,3.0)
call dynamic_typing%print_size()
type is (box_t)
call dynamic_typing%init(4.0,3.0,2.0)
call dynamic_typing%print_size()
end select
end program main
But I am not able to avoid the select type part. I would like to avoid it and do the stuff DIRECTLY in the select case part.
Something like that :
select case (choice)
case(1)
allocate(line_t::dynamic_typing)
call dynamic_typing%init(4.0)
call dynamic_typing%print_size()
case(2)
allocate(rectangle_t::dynamic_typing)
call dynamic_typing%init(4.0,3.0)
call dynamic_typing%print_size()
case(3)
allocate(box_t::dynamic_typing)
call dynamic_typing%init(4.0,3.0,2.0)
call dynamic_typing%print_size()
case default
print *,'not permitted'
stop
end select
Is it possible or not ?
Not. While you can't reference the type-bound procedures for a polymorphic object where the declared type is abstract, if you know the name of the specific procedure you can call it directly, passing the "this" argument explicitly.
The problem, though, is that the declared type of "this" in each of those procedures is an extension of the abstract type shape_t, and as such you can't pass an argument whose declared type is smaller than the extension. I discuss this in https://stevelionel.com/drfortran/2020/06/30/doctor-fortran-in-not-my-type/
Using select type makes the declared type, within each select block, be the named type and therefore you're allowed to pass it to the procedure.
Your code using select type is straightforward and clean.

OOP Fortran : How to create a factory with a variable number of arguments in the initialisation routine?

A suggested in the answer of Federico Perini(https://stackoverflow.com/a/72998466/7462275), I tried to write a factory to hide away all of the complexity in a separate module.
But, I do not manage to put in the module the init routine because the number of arguments depends of the object type (line, rectangle or box).
This is the code that I wrote but the I still have a select type in the main. And, I did not manage to put it in the module.
module myModule
implicit none
type CFactory
class(shape_t), pointer :: shape_type
contains
procedure :: create_shape
end type CFactory
type, abstract :: shape_t
contains
! Put init in a generic interface
procedure(abstract_init), nopass, deferred, private :: shared_init
generic :: init => shared_init
procedure(abstract_print), deferred :: print_size
end type shape_t
abstract interface
subroutine abstract_init()
end subroutine abstract_init
subroutine abstract_print(this)
import shape_t
class(shape_t), intent(in) :: this
end subroutine abstract_print
end interface
type, extends(shape_t) :: line_t
real :: length
contains
procedure, nopass, private :: shared_init => init_line
procedure :: init_line_1d
generic :: init => init_line_1d
procedure :: print_size => print_linesize
end type line_t
type, extends(shape_t) :: rectangle_t
real :: length,width
contains
procedure, nopass, private :: shared_init => init_rectangle
procedure :: init_rectangle_2d
generic :: init => init_rectangle_2d
procedure :: print_size => print_rectanglesize
end type rectangle_t
type, extends(shape_t) :: box_t
real :: length,width,height
contains
procedure, nopass, private :: shared_init => init_box
procedure :: init_box_3d
generic :: init => init_box_3d
procedure :: print_size => print_boxsize
end type box_t
contains
subroutine create_shape(this,choice)
class(CFactory), intent(inout) :: this
integer, intent(in) :: choice
select case (choice)
case(1)
allocate(line_t::this%shape_type)
case(2)
allocate(rectangle_t::this%shape_type)
case(3)
allocate(box_t::this%shape_type)
case default
print *,'not permitted'
stop
end select
end subroutine create_shape
subroutine init_line_1d(this,length1)
class(line_t), intent(inout) :: this
real, intent(in) :: length1
this%length = length1
end subroutine init_line_1d
subroutine print_linesize(this)
class(line_t), intent(in) :: this
print*,'Line size',this%length,'meter'
end subroutine print_linesize
subroutine init_rectangle_2d(this,length1,length2)
class(rectangle_t), intent(inout) :: this
real, intent(in) :: length1,length2
this%length = length1
this%width = length2
end subroutine init_rectangle_2d
subroutine print_rectanglesize(this)
class(rectangle_t), intent(in) :: this
print*,'Rectangle area',this%length*this%width,'meter^2'
end subroutine print_rectanglesize
subroutine init_box_3d(this,length1,length2,length3)
class(box_t), intent(inout) :: this
real, intent(in) :: length1,length2,length3
this%length = length1
this%width = length2
this%height = length3
end subroutine init_box_3d
subroutine print_boxsize(this)
class(box_t), intent(in) :: this
print*,'Box volume',this%length*this%width*this%height,'meter^3'
end subroutine print_boxsize
subroutine init_rectangle() ; end subroutine init_rectangle
subroutine init_line() ; end subroutine init_line
subroutine init_box() ; end subroutine init_box
end module myModule
program main
use myModule
implicit none
type(CFactory) :: factory
integer :: choice
print *,'choice (1:line, 2:rectangle or 3:box)'
read(*,'(i1)') choice
call factory%create_shape(choice)
select type (ptr => factory%shape_type)
type is (line_t)
call ptr%init(4.0)
type is (rectangle_t)
call ptr%init(4.0,3.0)
type is (box_t)
call ptr%init(4.0,3.0,2.0)
end select
call factory%shape_type%print_size()
end program main
I tried many things to have only in the main call factory%shape_type%someinitprocedure with one, or two or three arguments (for line, rectangular or box). Of course, a check will be performed in this subroutine to be sure that the number of arguments agrees with the shape_type.
(n.b. : I am discovering the factory concept, so my strategy is not the good one to hide away the complexity in a module)
Thanks for answer
In your example, shape sizes (width, length, depth) are a property of the instantiated object. You're not initializing a generic box or a generic line (that is what a derived type represents) but THAT box, with that width, length, depth (assume they can never change, for now).
So you want to have them set once and forall in the factory, where you can also do all your nice checks. Think something like:
module shape_factory
use shape_types ! where the class definitions are
implicit none
type, public :: shape_creator
! Configuration variables
real :: max_width = blabla
real :: min_depth = etcetc
! Some stats
integer :: created_sofar = 0
contains
procedure :: create => init_shape
end type shape_creator
contains
subroutine init_shape(this, the_shape, which_type, width, length, depth, radius)
class(shape_creator), intent(inout) :: this
class(shape_t), allocatable, intent(out) :: the_shape
integer, intent(in) :: which
real, optional, intent(in) :: width, length, depth, radius
select case (which_type)
case (1); allocate(box_t :: the_shape)
if (.not.present(width)) stop 'width is mandatory for box_t'
if (.not.present(depth)) stop 'depth is mandatory for box_t'
if (.not.present(length)) stop 'length is mandatory for box_t'
the_shape = box_t(width, depth,length)
case (2); allocate(circle_t :: the_shape)
if (.not.present(radius)) stop 'radius is mandatory for circle_t'
the_shape = circle_t(radius)
case default
stop 'shape factory: invalid shape type requested '
end select
! Keep counter
this%created_sofar = this%created_sofar + 1
end subroutine init_shape
end module shape_factory
program create_shapes
use shape_factory
use shape_types
type(shape_creator) :: factory
class(shape_t), allocatable :: shape
call factory%create(shape,2,radius=0.5); call shape%print()
call factory%create(shape,1,width=1.0); ! Error! not enough arguments
! etc.
end program

Extending an object and overriding a procedure without being deferred in Fortran

I have a code with lots of different features and methods. Some methods are all for the same feature, i.e. only one among a selection can be selected.
Furthermore, depending on a feature I might need to do modify subroutines elsewhere. So in a loop in routine inject I might have a small if statement asking if I have used feature A, then do a few extra operations.
This is very frustating since different features seems to be connected with others routines very arbirarirly, and can be difficult to maintain.
I have decided to do following to avoid this:
I define an object t_inject with the purpose to execture routine inject. I rewrite my routine inject such that it contains only the code that is common for all different scenarios.
type t_inject
contains
procedure,nopass :: inject => inject_default
end type
Now I have another object to handle my feature A in case it is selected.
type,extends(t_inject) :: t_inject_a
contains
procedure, nopass :: inject => inject_a
end type
My subroutines inject_a and inject have same interface. E.g.
subroutine inject_a( part )
type(t_part) , intent(inout) :: part % an external data type
call inject(part)
! do the extra bit of stuff you need to do
end subroutine
subroutine inject( part)
type(t_part) , intent(inout) :: part % an external data type
! carry out the default stuff
end subroutine
Now in my main program
class(t_inject) :: inj
allocate(inj :: t_inject_a)
call inj% inject ( part)
Is that the way you would do it and is it valid?
I initially thought of doing an abstract declared type with a deferred inject procedure where I then could extent.
But for a very trivial problem I might not need that - I am also wondering whether my call call inj% inject(part) is sufficient for the compiler to know to where to go. Sometimes I see codes which need the class is condition before making the call.
I think three points should be modified:
The type-bound procedures need to refer to actual procedure names (via =>). So, I have changed the name of a module procedure inject() to inject_default(). (But please see test2.f90 also).
We need to attach allocatable to a class variable (e.g., inj2) to allocate it with a concrete type (e.g., t_inject_a).
In the allocate statement, the name of a concrete type should appear before ::, such that allocate( t_inject_a :: inj2 ).
The modified code may look like this:
!! test.f90
module test_mod
implicit none
type t_inject
contains
procedure, nopass :: inject => inject_default
endtype
type, extends(t_inject) :: t_inject_a
contains
procedure, nopass :: inject => inject_a
endtype
type t_part !! some other type
integer :: x = 100, y = 200
endtype
contains
subroutine inject_default( part )
type(t_part), intent(inout) :: part
print *, "x = ", part % x
endsubroutine
subroutine inject_a( part )
type(t_part), intent(inout) :: part
call inject_default( part )
print *, "y = ", part % y
endsubroutine
end
program main
use test_mod
implicit none
class( t_inject ), allocatable :: inj1, inj2
type( t_part ) :: part
!! Polymorphic allocation with concrete types.
allocate( t_inject :: inj1 )
allocate( t_inject_a :: inj2 )
print *, "inj1:"
call inj1 % inject( part )
print *, "inj2:"
call inj2 % inject( part )
end
"gfortran-8 test.90 && ./a.out" gives
inj1:
x = 100
inj2:
x = 100
y = 200
We can also use a module procedure inject() (rather than inject_default()) by using procedure, nopass :: inject, for example:
!! test2.f90
module test_mod
implicit none
type t_inject
contains
procedure, nopass :: inject
! procedure, nopass :: inject => inject !! this also works
endtype
type, extends(t_inject) :: t_inject_a
contains
procedure, nopass :: inject => inject_a
endtype
type t_part !! some other type
integer :: x = 100, y = 200
endtype
contains
subroutine inject( part )
type(t_part), intent(inout) :: part
print *, "x = ", part % x
endsubroutine
subroutine inject_a( part )
type(t_part), intent(inout) :: part
call inject( part )
print *, "y = ", part % y
endsubroutine
end
!! The remaining part (and the result) is the same...
In addition, one can also separate actual procedures like inject() in a different file and use them to define new types like t_inject (see mylib.f90 and test3.f90 below). This might be useful to reuse routines in some library file.
!! mylib.f90
module mylib
implicit none
type t_part !! some other type
integer :: x = 100, y = 200
endtype
contains
subroutine inject( part )
type(t_part), intent(inout) :: part
print *, "x = ", part % x
end
subroutine inject_a( part )
type(t_part), intent(inout) :: part
call inject( part )
print *, "y = ", part % y
end
end
!! test3.f90
module test_mod
use mylib
implicit none
type t_inject
contains
procedure, nopass :: inject
endtype
type, extends(t_inject) :: t_inject_a
contains
procedure, nopass :: inject => inject_a
endtype
end
!! The main program is the same as test.f90.
!! compile: gfortran-8 mylib.f90 test3.f90

How to use polymorphic data type as attribute of another data type in Fortran

I have created a class called 'element' that has several attributes and type-bound procedures. One of the attributes is an abstract class type 'kin' that has two inherited type 'kin1' and 'kin2'. I would like to be able to assign 'kin1' or 'kin2' as a attribute to the object 'element' at run time using the constructor depending on the inputs. The objective is to have a list of elements, each one with element%kin being either 'kin1' type or 'kin2' type.
Module element
module element
use kin
implicit none
type,public :: element_type
class(kin_type),allocatable :: kin
contains
procedure,pass(this), private :: set_kin
procedure,pass(this), public :: get_kin
end type element_type
interface element_type
module procedure element_type_constructor
end interface element_type
contains
type (element_type) function element_type_constructor(kin)
implicit none
class(kin_type),allocatable, intent (in) :: kin
call element_type_constructor%set_kin(kin)
end function element_type_constructor
! my try of set_kin
subroutine set_kin(this,kin)
implicit none
class(element_type), intent(inout) :: this
class(kin_type),allocatable, intent(in) :: kin
this%kin = kin
end subroutine
end module element
Module kin
module kin
implicit none
private
type,abstract :: kin_type
end type kin_type
type,public, extends(kin_type) :: kin1_type
private
integer :: data1
contains
procedure,pass(this),private :: set_data1
procedure,pass(this),public :: get_data1
procedure,pass(this),public :: print =>print_kin1
end type kin1_type
type,public, extends(kin1_type) :: kin2_type
private
real :: data2
contains
procedure,pass(this),private :: set_data2
procedure,pass(this),public :: get_data2
procedure,pass(this),public :: print =>print_kin2
end type kin2_type
! constructor interface kin1_type
interface kin1_type
module procedure kin1_type_constructor
end interface kin1_type
! constructor interface kin2_type
interface kin2_type
module procedure kin2_type_constructor
end interface kin2_type
contains
! constructor kin1_type
type (kin1_type) function kin1_type_constructor(data1)
implicit none
integer, intent (in) :: data1
class(kin1_type), intent (in) :: kin
call kin1_type_constructor%set_data1(data1)
end function kin1_type_constructor
! constructor kin2_type
type (kin2_type) function kin1_type_constructor(data1,data2)
implicit none
integer, intent (in) :: data1
real, intent (in) :: data2
class(kin2_type), intent (in) :: kin
call kin2_type_constructor%set_data1(data1)
call kin2_type_constructor%set_data2(data2)
end function kin2_type_constructor
! Example of set subroutine
subroutine set_data1(this,data1)
class(kin1_type),intent(inout) :: this
integer, intent(in) :: data1
this%data1 = data1
end subroutine set_data1
! other procedures...
end module kin
Program
program test
use element
use kin
implicit none
type(element_type) :: thisElement
type(kin1_type) :: thisKin1
! constructor for thisKin1
thisKin1 = kin1_constructor(data1 = 1)
! constructor for thisElement
thisElement = element_type_constructor(kin = thisKin1)
! Check kin structure and values
call thisElement%kin%print
end program
Error
I receive the following error during the run of the element_type_constructor subroutine:
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
I can't comment yet, so here it goes as a first answer: the provided code is unfortunately incomplete. Furthermore, the vendor and version of the compiler is missing, which makes it really hard to guess what the actual problem is.
"Fixing" the code to get the following example shows that it is in principle working:
kin.f90:
module kin
implicit none
private
type,abstract,public :: kin_type
contains
procedure(print_iface), deferred :: print
end type kin_type
type,public, extends(kin_type) :: kin1_type
private
integer :: data1
contains
procedure,pass(this),private :: set_data1
procedure,pass(this),public :: print => print_kin1
end type kin1_type
! constructor interface kin1_type
interface kin1_type
module procedure kin1_type_constructor
end interface kin1_type
abstract interface
subroutine print_iface(this)
import kin_type
class(kin_type), intent(in) :: this
end subroutine
end interface
contains
! constructor kin1_type
type (kin1_type) function kin1_type_constructor(data1)
implicit none
integer, intent (in) :: data1
call kin1_type_constructor%set_data1(data1)
end function kin1_type_constructor
! Example of set subroutine
subroutine set_data1(this,data1)
class(kin1_type),intent(inout) :: this
integer, intent(in) :: data1
this%data1 = data1
end subroutine set_data1
subroutine print_kin1(this)
class(kin1_type),intent(in) :: this
print *, this%data1
end subroutine print_kin1
end module kin
element.f90:
module element
use kin, only: kin_type
implicit none
type,public :: element_type
class(kin_type), allocatable :: kin
contains
procedure,pass(this), private :: set_kin
end type element_type
interface element_type
module procedure element_type_constructor
end interface element_type
contains
type (element_type) function element_type_constructor(kin)
implicit none
class(kin_type), intent (in) :: kin
call element_type_constructor%set_kin(kin)
end function element_type_constructor
! my try of set_kin
subroutine set_kin(this,kin)
implicit none
class(element_type), intent(inout) :: this
class(kin_type), intent(in) :: kin
this%kin = kin
end subroutine
end module element
main.f90:
program test
use element
use kin
implicit none
type(element_type) :: thisElement
class(kin_type), allocatable :: thisKin1
! constructor for thisKin1
thisKin1 = kin1_type(data1 = 1)
! constructor for thisElement
thisElement = element_type(kin = thisKin1)
call thisElement%kin%print()
end program
Building it with gfortran 7.4.0 and runnig it yields:
$ gfortran -o prog kin.f90 element.f90 main.f90
$ ./prog
1
$
One notable difference to what was provided is the deferred print procedure on the abstract type since it is being called via an attribute defined as a class(kin_type). Unfortunately that does not explain the cited error.

Good OOP design to avoid copy/paste in Fortran

Given the minimal working example below, I would like to modify it to avoid copy/pasting the calls of
call func_some_calc1(par)
call func_some_calc2(par)
in both main_func_problem1 and main_func_problem2.
Ideally I want to have one function main_func that is behaving differently for input parameters of type t_parameters_problem1 and t_parameters_problem2. I could declare its par parameter of base type class(t_parameters_base), but then having a switch inside that function depending on the actual argument type (using select type) is architecturally not good.
To solve this I tried to create a procedure in type t_parameters_base, which is calling those routines, to implement something like this (C++ syntax):
class t_parameters_base {
virtual void main_func() {
func_some_calc1(this)
func_some_calc2(this)
}
}
class t_parameters_problem1: public t_parameters_base {
virtual void main_func() {
t_parameters_base::main_func();
func_some_calc3_problem1(this);
}
}
But the problem is that those routines are using an input parameter of this type, which leads to circular dependency. How is it possible to solve this problem?
Update: Note that I really want to keep the implementation of func_some_calc1 and func_some_calc2 in different files (modulus/classes) as they implement very different logic using some private functions from their classes.
module parameters_base
type, public :: t_parameters_base
integer :: n
end type t_parameters_base
end module parameters_base
module parameters_problem1
use parameters_base
implicit none
type, extends(t_parameters_base), public :: t_parameters_problem1
integer :: p1
end type t_parameters_problem1
end module parameters_problem1
module parameters_problem2
use parameters_base
implicit none
type, extends(t_parameters_base), public :: t_parameters_problem2
integer :: p2
end type t_parameters_problem2
end module parameters_problem2
module some_calc1
use parameters_base
implicit none
contains
subroutine func_some_calc1(par)
class(t_parameters_base) :: par
end subroutine func_some_calc1
end module some_calc1
module some_calc2
use parameters_base
implicit none
contains
subroutine func_some_calc2(par)
class(t_parameters_base) :: par
end subroutine func_some_calc2
end module some_calc2
module some_calc3_problem1
use parameters_problem1
implicit none
contains
subroutine func_some_calc3_problem1(par)
type(t_parameters_problem1) :: par
print*, par%p1
end subroutine func_some_calc3_problem1
end module some_calc3_problem1
module some_calc3_problem2
use parameters_problem2
implicit none
contains
subroutine func_some_calc3_problem2(par)
type(t_parameters_problem2) :: par
print*, par%p2
end subroutine func_some_calc3_problem2
end module some_calc3_problem2
module main_problem1
use parameters_problem1
use some_calc1
use some_calc2
use some_calc3_problem1
implicit none
contains
subroutine main_func_problem1(par)
type(t_parameters_problem1) :: par
call func_some_calc1(par)
call func_some_calc2(par)
call func_some_calc3_problem1(par)
end subroutine main_func_problem1
end module main_problem1
module main_problem2
use parameters_problem2
use some_calc1
use some_calc2
use some_calc3_problem2
implicit none
contains
subroutine main_func_problem2(par)
type(t_parameters_problem2) :: par
call func_some_calc1(par)
call func_some_calc2(par)
call func_some_calc3_problem2(par)
end subroutine main_func_problem2
end module main_problem2
program module_test
use parameters_problem1
use parameters_problem2
use main_problem1
use main_problem2
implicit none
type(t_parameters_problem1) :: par1
type(t_parameters_problem2) :: par2
par1%p1 = 1
par2%p2 = 2
call main_func_problem1(par1)
call main_func_problem2(par2)
end program module_test
I think, what you are aiming for are polymorphic types with type bound procedures. Below you find a working example. To keep it simple, I do not have added any data to the types, but of course, that can be easily done. The routine invokeCalc12 is only defined in the base type, but can be invoked from the derived types, and as in Fortran all methods are virtual, it will call the right methods.
module calc_base
implicit none
type, abstract :: CalcBase
contains
procedure(calcInterface), deferred :: calc1
procedure(calcInterface), deferred :: calc2
procedure :: invokeCalc12
end type CalcBase
interface
subroutine calcInterface(self, ii)
import :: CalcBase
class(CalcBase), intent(inout) :: self
integer, intent(in) :: ii
end subroutine calcInterface
end interface
contains
subroutine invokeCalc12(self, ii)
class(CalcBase), intent(inout) :: self
integer, intent(in) :: ii
call self%calc1(ii)
call self%calc2(ii)
end subroutine invokeCalc12
end module calc_base
module some_calc
use calc_base
implicit none
type, extends(CalcBase) :: SomeCalc
contains
procedure :: calc1
procedure :: calc2
procedure :: calc3
end type SomeCalc
contains
subroutine calc1(self, ii)
class(SomeCalc), intent(inout) :: self
integer, intent(in) :: ii
print *, "SomeCalc1:calc1", ii
end subroutine calc1
subroutine calc2(self, ii)
class(SomeCalc), intent(inout) :: self
integer, intent(in) :: ii
print *, "SomeCalc1:calc2", ii
end subroutine calc2
subroutine calc3(self, ii)
class(SomeCalc), intent(inout) :: self
integer, intent(in) :: ii
call self%%invokeCalc12(ii)
end subroutine calc3
end module some_calc
program test
use some_calc
implicit none
type(SomeCalc) :: mySimulation
call mySimulation%calc3(42)
end program test
Note: I've seen that similar question has been posted at comp.lang.fortran, but at the moment I did not find a working example there, therefore the posting here.