Я обновляю немного кода новыми функциями, и в идеале мое решение должно включать массив, в котором каждый элемент имеет другой тип, что невозможно в Фортране. Поэтому я попытался использовать массив полиморфных объектов, но застрял в точке, в которой после инициализации элементов массива я не могу вызвать ни одну из подпрограмм, связанных с типом.
Вот суть проблемы.
Модуль объявления типов:
type :: fruit
end type fruit
type, extends(fruit) :: apples
contains
procedure :: init => init_apples
end type apples
type, extends(fruit) :: oranges
contains
procedure :: init => init_oranges
end type oranges
contains
pure subroutine init_apples(me)
class(apples), intent(inout) :: me
! Do Stuff
end subroutine init_appples
pure subroutine init_oranges(me)
class(oranges), intent(inout) :: me
! Do Stuff
end subroutine init_oranges
В основной программе тогда:
use apropriate module
type fruit_basket
class(fruit), allocatable :: item
end type
type(fruit_basket), allocatable :: gift(:)
allocate(gift(2))
!Option 1
allocate(apples::gift(1).item)
allocate(oranges::gift(2).item)
!Option 2
gift(1) = fruit_basket(apples)
gift(2) = fruit_basket(oranges)
компилятор принимает любой из вышеуказанных параметров. Теперь в идеале я хотел бы вызвать init для одного из этих элементов
!Tried this
call gift(1).init()
!Also tried this
call gift(1).item.init()
любой из этих вариантов выдает ошибку:
ошибка # 6460: это не имя поля, которое определено в охватывающей структуре. [INIT]
Что я делаю не так?
Edit:
Так что я как бы заставил его работать, не очень доволен тем, как он работает, но, полагаю, он подойдет:
Объявление типа:
Module type_declaration
implicit none
type, abstract, public :: Base_Type
contains
procedure(init_base), deferred :: init
procedure(get_base), deferred :: GetResult
end type
interface
pure subroutine init_base(this, x)
import Base_Type
class(base_type), intent(inout) :: this
real(8), intent(in) :: x
end subroutine
real(8) pure function get_base(this)
import Base_Type
class(base_type), intent(in) :: this
end function
end interface
type, extends(Base_Type) :: Subtype1
real(8) alpha
contains
procedure :: init => init_type1
procedure :: GetResult => get_res_type1
end type
type, extends(Base_Type) :: Subtype2
real(8) alpha, beta
contains
procedure :: init => init_type2
procedure :: GetResult => get_res_type2
end type
contains
pure subroutine init_type1(this, x)
class(Subtype1), intent(inout) :: this
real(8), intent(in) :: x
!Work here
this.alpha = x * 2.
end subroutine
pure subroutine init_type2(this, x)
class(Subtype2), intent(inout) :: this
real(8), intent(in) :: x
!Work here
this.alpha = x * 2
this.beta = x / 3.
end subroutine
real(8) pure function get_res_type1(this)
class(Subtype1), intent(in) :: this
get_res_type1 = this.alpha
end function
real(8) pure function get_res_type2(this)
class(Subtype2), intent(in) :: this
get_res_type2 = this.alpha + this.beta
end function
end module type_declaration
Основная программа Вариант 1:
program Polymorhic_Test
use type_declaration
implicit none
type data_container
class(Base_type), allocatable :: item
end type
type(data_container) :: MainArray(2)
real(8) :: x, y = 0.
character(10) :: cDummy
allocate(Subtype1::MainArray(1).item)
allocate(Subtype2::MainArray(2).item)
x = 1.
call MainArray(1).item.init(x)
y = MainArray(1).item.GetResult()
x = 2.
call MainArray(2).item.init(x)
y = MainArray(2).item.GetResult()
read cDummy
end program Polymorhic_Test
Основной вариант программы 2
program Polymorhic_Test
use type_declaration
implicit none
type data_container
class(Base_type), allocatable :: item
end type
type(data_container) :: MainArray(2)
real(8) :: x, y = 0.
character(10) :: cDummy
type(Subtype1) :: ST1
type(Subtype2) :: ST2
x = 1.
call ST1.init(x)
allocate(MainArray(1).item, source=ST1)
y = MainArray(1).item.GetResult()
x = 2.
call ST2.init(x)
allocate(MainArray(2).item, source=ST2)
y = MainArray(2).item.GetResult()
read cDummy
end program Polymorhic_Test
Я, вероятно, пойду с вариантом 2, просто потому, что мне тогда не придется откладывать init в базовом типе, потому что мои подтипы будут иметь различное количество параметров, необходимых для init, и мне не нравится идея иметь base введите init с 20 дополнительными параметрами.