I wrote the following code where an abstract type (shape_t) could be extended to a segment, a rectangle or a box. There are two procedures, one to initialize the variable and the other to print the size.
This code gave the expected result.
A segment, a rectangle or a box could be initialized and the size could be printed.
module myModule
implicit none
type, abstract :: shape_t
contains
procedure(abstract_init), deferred :: 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 :: init => init_line
procedure :: print_size => print_linesize
end type line_t
type, extends(shape_t) :: rectangle_t
real :: length,width
contains
procedure :: init => init_rectangle
procedure :: print_size => print_rectanglesize
end type rectangle_t
type, extends(shape_t) :: box_t
real :: length,width,height
contains
procedure :: init => init_box
procedure :: print_size => print_boxsize
end type box_t
contains
subroutine init_line(this,length1,length2,length3)
class(line_t), intent(inout) :: this
real, intent(in) :: length1,length2,length3
this%length = 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
this%length = length1
this%width = length2
end subroutine init_rectangle
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(line_t), allocatable :: segment
class(rectangle_t), allocatable :: rectangle
class(box_t), allocatable :: box
allocate(line_t::segment)
call segment%init(12.0,0.0,0.0)
call segment%print_size()
allocate(rectangle_t::rectangle)
call rectangle%init(12.0,5.0,0.0)
call rectangle%print_size()
allocate(box_t::box)
call box%init(12.0,5.0,2.0)
call box%print_size()
end program main
But as there are no the same number of dimensions between segment, rectangle and box and I do not know how to overload a procedure in a abstract interface, I use 3 real parameters to initialise variables (even for segment and rectangle where only one or two are needed, respectively).
I wonder how is it possible to modify this code, to change in the main program :
call segment%init(12.0,0.0,0.0) and call rectangle%init(12.0,5.0,0.0) to call segment%init(12.0) and call rectangle%init(12.0,5.0)
Thanks for answer.
The deferred procedure in the abstract interface needs to have the same interface in all extended classes. This is unfortunate, but Fortran has no easy way to work around this. I think you have two options:
optional, and then check inside each class implementation that all inputs you need have already been provided, like: subroutine abstract_init(this,length1,length2,length3)
import shape_t
class(shape_t), intent(inout) :: this
real, intent(in) :: length1
real, intent(in), optional :: length2,length3
end subroutine abstract_init
generic interface to init. In other words, you're going to write more wrappers to the initialization function, that allow for different inputs. This is an example: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(line_t), allocatable :: segment
class(rectangle_t), allocatable :: rectangle
class(box_t), allocatable :: box
allocate(line_t::segment)
call segment%init(12.0)
call segment%print_size()
allocate(rectangle_t::rectangle)
call rectangle%init(12.0,5.0)
call rectangle%print_size()
allocate(box_t::box)
call box%init(12.0,5.0,2.0)
call box%print_size()
end program main
In other words, the deferred procedure always represents a shared common procedure to all instances. Also keep in mind that you can always use default initializers, like:
allocate(segment ,source=line_t(length=12.0))
allocate(rectangle,source=rectangle_t(length=12.0,width=5.0))
allocate(box ,source=box_t(length=12.0,width=5.0,depth=2.0))