In the following module, an abstract type (Base_Arrays_class
) is declared and two types are derived (One_Array_t
and Two_Arrays_t
). In the abstract type, there is a procedure abstract_init
deferred to init
.
In the derived types, the subroutines one_array_init
and two_arrays_init
are used to init the array(s).
module my_mod
implicit none
type, abstract :: Base_Arrays_class
integer :: array_size
real,dimension(:), allocatable :: array
contains
procedure(abstract_init), deferred :: init
end type Base_Arrays_class
abstract interface
subroutine abstract_init(this,array_size)
import Base_Arrays_class
class(Base_Arrays_class), intent(inout) :: this
integer, intent(in) :: array_size
end subroutine abstract_init
end interface
type, extends(Base_Arrays_class) :: One_Array_t
contains
procedure :: init => one_array_init
end type One_Array_t
type, extends(Base_Arrays_class) :: Two_Arrays_t
real,dimension(:), allocatable :: second_array
contains
procedure :: init => two_arrays_init
end type Two_Arrays_t
contains
subroutine one_array_init(this,array_size)
class(One_Array_t), intent(inout) :: this
integer, intent(in) :: array_size
this%array_size=array_size
allocate(this%array(array_size))
this%array=1.0
end subroutine one_array_init
subroutine two_arrays_init(this,array_size)
class(Two_Arrays_t), intent(inout) :: this
integer, intent(in) :: array_size
this%array_size=array_size
allocate(this%array(array_size), this%second_array(array_size))
this%array=2.0
this%second_array=3.0
end subroutine two_arrays_init
end module my_mod
Below, an example of program that uses this module.
program pgm
use my_mod
implicit none
type(One_Array_t) :: one_array
type(Two_Arrays_t) :: two_arrays
integer :: i, size
size = 4
call one_array%init(size)
call two_arrays%init(size)
print *,"one_array"
do i=1,size
print *, one_array%array(:)
end do
print *,"two_arrays"
do i=1,size
print *, two_arrays%array(:)
end do
print *
do i=1,size
print *, two_arrays%second_array(:)
end do
end program pgm
It works perfectly.
But now, I would like to overload init
to choose the init value(s). For example :
call one_array%init(size,4)
and call two_arrays%init(size, 5,8)
.
So, overload of init
is needed. Something like that (for One_Array_t
) :
interface init
module procedure one_array_init, one_array_init2
end interface init
But, it does not conform to abstract_init
and I could not be able to do this overload.
Is it possible or not ?
Thanks for answers.