如何在Fortran中创建和使用类型扩展数组?

时间:2015-10-21 15:21:28

标签: oop fortran

我有一个抽象的基类。我对基类进行了两次扩展。我想将从任一扩展类生成的所有对象存储在一个数组中。我相信我能够通过创建一个指向基类的指针数组来做到这一点;我可以使用基类的任何扩展来填充这样的数组。但是,当我尝试调用扩展类对象的过程时,编译器会抱怨该过程不在基类中。我想代码会知道指针指向一个扩展,看看它的类型绑定程序,但显然我错了。

示例如下所示。我有两个问题:我需要做些什么才能解决这个问题,这是解决我想要解决的问题的根本错误方法吗?

module thetype

   implicit none

   type, abstract :: base
      integer :: ival
   end type base

   type, extends(base) :: extend1
      real :: val
      contains
         procedure :: Init=>Init_extend1
         procedure :: Print=>Print_extend1
   end type extend1

   type, extends(base) :: extend2
      character(len=1) :: chr
      contains
         procedure :: Init=>Init_extend2
         procedure :: Print=>Print_extend2
   end type extend2

   type :: ptr
      class(base), pointer :: ptrobj
   end type

contains

   subroutine Init_extend1(me,ival,val)
      class(extend1), intent(in out) :: me
      integer, intent(in) :: ival
      real, intent(in) :: val
      me%ival=ival
      me%val=val
   end subroutine Init_extend1

   subroutine Print_extend1(me,id)
      class(extend1), intent(in) :: me
      integer, intent(in) :: id
      print *, "Extend1 obj:", id
      print *, me%ival
      print *, me%val
   end subroutine Print_extend1

   subroutine Init_extend2(me,ival,chr)
      class(extend2), intent(in out) :: me
      integer, intent(in) :: ival
      character(len=1), intent(in) :: chr
      me%ival=ival
      me%chr=chr
   end subroutine Init_extend2

   subroutine Print_extend2(me,id)
      class(extend2), intent(in) :: me
      integer, intent(in) :: id
      print *, "Extend2 obj:", id
      print *, me%ival
      print *, me%chr
   end subroutine Print_extend2
end module thetype

program main
   use thetype
   implicit none

   type(extend1), target, allocatable :: extend1_obj(:)
   type(extend2), target, allocatable :: extend2_obj(:)
   type(ptr), allocatable :: ptrs(:)
   integer :: i

   allocate(extend1_obj(1))
   allocate(extend2_obj(2))
   allocate(ptrs(3))

   call extend1_obj(1)%Init(1,2.0)

   call extend2_obj(1)%Init(3,'a')
   call extend2_obj(2)%Init(3,'b')

   ptrs(1)%ptrobj=>extend1_obj(1)
   ptrs(2)%ptrobj=>extend2_obj(1)
   ptrs(3)%ptrobj=>extend2_obj(2)

   do i=1,size(ptrs,1)
      call ptrs(i)%ptrobj%Print(i)
   end do

end program main

0 个答案:

没有答案