Выделение массива абстрактного типа в Фортране - PullRequest
Новая
       20

Выделение массива абстрактного типа в Фортране

0 голосов
/ 21 марта 2019

По сути, у меня есть абстрактный класс a класс оболочки и базовый класс , которые определены в Базовом модуле . Класс abbstract содержит размещаемый массив и подпрограмму. В конструкторе я хочу выделить этот массив, но это не работает.

Распределение работает для Base, но я думаю, это не то, что я хочу, так как дочерний класс ничего не знает из Base. Как бы я сделал это распределение?

Вот что у меня есть:

Базовый модуль 

module BaseClass

    implicit none

    ! ------------------------
    ! ABSTRACT CLASS
    ! ------------------------
    type, abstract :: AbsBaseHelper
        real, allocatable :: A(:)  !! <-- this makes problems
    contains
        procedure :: construct
        procedure(help_int), deferred :: help
    end type

    ! ------------------------
    ! WRAPPER CLASS
    ! ------------------------
    type :: BaseWrap
        integer :: cI
        class(AbsBaseHelper), pointer :: p
    contains
        procedure :: do_something
    end type

    ! ------------------------
    ! INTERFACE
    ! ------------------------
    interface
        subroutine help_int(this)
            import AbsBaseHelper
            implicit none
            class(AbsBaseHelper), intent(inout) :: this
        end subroutine help_int
    end interface

    ! ------------------------
    ! BASE CLASS
    ! ------------------------
    type(BaseWrap) :: Base(2)

contains

    ! ------------------------
    ! CONSTRUCTOR
    ! ------------------------
    subroutine construct(this, id)

        implicit none
        class(AbsBaseHelper), intent(in), target :: this
        integer, intent(in) :: id

        Base(id)%cI =  id
        ! allocate( this%A(2) )         !! <-- does not work because this is only intent(in)
        Base(id)%p  => this
        allocate( Base(id)%p%A(2) )     !! <-- does not work because it gives segmentation fault in 'help'

    end subroutine construct

    ! ------------------------
    ! THE MAIN SUBROUTINE
    ! ------------------------
    subroutine do_something(this)

        implicit none

        class(BaseWrap), intent(inout) :: this

        print*, "Base Index : ", this%cI
        call this%p%help()
        print*, "Result 1 : ", this%p%A(1)
        print*, "Result 2 : ", this%p%A(2)

    end subroutine do_something

end module BaseClass

дочерний модуль 

module ChildClass1

    use BaseClass

    implicit none

    type, extends(AbsBaseHelper) :: Child1
    contains
        procedure :: help
    end type

contains

    subroutine help(this)
        implicit none
        class(Child1), intent(inout) :: this

        this%A(1) = 1   !! <-- produces segmentation fault
        this%A(2) = 2
    end subroutine

end module ChildClass1

Программа 

program test

    use BaseClass

    implicit none

    call init
    call Base(1)%do_something()

contains

    ! ------------------------
    ! INITIALIZE
    ! ------------------------
    subroutine init

        use ChildClass1

        implicit none

        type(Child1), target :: c1

        call c1%construct(1)

    end subroutine init

end program test
...