Динамический класс в Фортране - PullRequest
2 голосов
/ 21 октября 2019

В этой простой программе, когда я компилирую программу, она выдаст мне ошибку в отношении того, что «выделенный объект BoundaryConditionLTU уже выделен». Я знаю проблему, но я не знаю, как ее исправить. Пожалуйста, дайте мне знать, как это исправить. Спасибо. Этот код является частью кода CFD, который я пытаюсь использовать для Граничных условий. Определены три общих граничных условия (т. Е. Дирихеле, Неймана, А смешанного до н.э.). Каждой из переменных потока, таких как скорость, давление и температура, будет присвоено одно из упомянутых граничных условий в начале кода. ClassBoundaryCond является абстрактным классом. Примечание. ClassDirichlet_BC, ClassNeumann_BC и ClassMix_B - это наследование ClassBoundaryCond (расширенный тип ClassBoundaryCond).

    module BoundaryCondition
    ! Date : 08/1/2019
    use Varibales_Nst_NoImm_2D_MPH_DEM
    !use SubroutineModule
    implicit none
    !=====================================================================
    ! Classes
    type,abstract :: ClassBoundaryCond
       contains
       procedure(InterfaceBound)  ,deferred :: evaluateBound
       procedure(InterfaceBound_N),deferred :: evaluateBound_Neu
    end type ClassBoundaryCond
!............................................    
    type,extends(ClassBoundaryCond) :: ClassDirichlet_BC
    contains
    procedure :: evaluateBound=>evaluateDir
    procedure :: evaluateBound_Neu=>evaluateNeu_Dir
    end type ClassDirichlet_BC
    !==============
    type,extends(ClassBoundaryCond) :: ClassNeumann_BC
    contains
    procedure :: evaluateBound=>evaluateNeu
    procedure :: evaluateBound_Neu=>evaluateNeu_Neu
    end type ClassNeumann_BC
    !==============
    type,extends(ClassBoundaryCond) :: ClassMix_BC
    contains
    procedure :: evaluateBound=>evaluateMix
    procedure :: evaluateBound_Neu=>evaluateNeu_Mix
    end type ClassMix_BC
    !==============
    !=====================================================================
    ! Interfaces
    !---------------------------------------
    abstract interface
    !---------------------------------------
    subroutine InterfaceBound(this)
    import :: ClassBoundaryCond
    class(ClassBoundaryCond) :: this
    end subroutine InterfaceBound
    !---------------------------------------
    end interface
    !=====================================================================
    ! ClassBoundaryCond is an abstract class
    !=====================================================================
    ! Decelerations
    class(ClassBoundaryCond),allocatable,Dimension(:) :: BoundaryConditionLTU
    !=====================================================================
    contains
    !=====================================================================

    subroutine initiateBoundaryCondition()
    implicit none

    integer :: i
    ! Date : 06/24/2019
    ! Arguments
    ! Body
    do i=1,6
        if (leftBC(i) == 0) then
            allocate(ClassDirichlet_BC::BoundaryConditionLTU(i))
        else if (leftBC(i) == 1) then
            allocate(ClassNeumann_BC::BoundaryConditionLTU(i))
        else if (leftBC(i) == 2) then
            allocate(ClassMix_BC::BoundaryConditionLTU(i))
        end if
    end do
    end subroutine initiateBoundaryCondition
    SUBROUTINE evaluateDir(this)
    Implicit None
    !     Start of Variable Definition
    !     ----------------------------
    Class(ClassDirichlet_BC) :: this
    END SUBROUTINE
    SUBROUTINE evaluateNeu(this)
    Implicit None
    !     Start of Variable Definition
    !     ----------------------------
    Class(ClassNeumann_BC) :: this


    END SUBROUTINE
    SUBROUTINE evaluateMix(this)
    Implicit None
    !     Start of Variable Definition
    !     ----------------------------
    Class(ClassMix_BC) :: this


    END SUBROUTINE
    end module BoundaryCondition

1 Ответ

1 голос
/ 22 октября 2019

Из того, что я понимаю, class(ClassBoundaryCond),allocatable,Dimension(:) :: BoundaryConditionLTU - это полиморфный массив объектов расширенного типа ClassBoundaryCond, что означает, что вы хотите, чтобы BoundaryConditionLTU был массивом, в котором некоторые элементы имеют тип ClassDirichlet_BC, другие ClassNeumann_BC и т. Д. думаю, что это вообще возможно, но я могу ошибаться.

Для реализации такого объекта может быть одно решение (не проверено):

module BoundaryCondition
! ... some codes

! We define a derived type where it's bc component can be any extended type of ClassBoundaryCond
type :: polymorphic_array_type
  class(ClassBoundaryCond),allocatable :: bc
end type

! Then we declare a dynamic array of this type
type(polymorphic_array_type),dimension(:), allocatable :: BoundaryConditionLTU

! ... some codes

!=====================================================================
contains
!=====================================================================

subroutine initiateBoundaryCondition()
implicit none

! We have i from 1 to 6 so somewhere there is a statement
! allocate(BoundaryConditionLTU(6))

do i=1,6
    if (leftBC(i) == 0) then
        allocate(BoundaryConditionLTU(i)%bc,source=ClassDirichlet_BC())
    else if (leftBC(i) == 1) then
        allocate(BoundaryConditionLTU(i)%bc,source=ClassNeumann_BC())
    else if (leftBC(i) == 2) then
        allocate(BoundaryConditionLTU(i)%bc,source=ClassMix_BC())
    end if
end do

! Then you may use BoundaryConditionLTU(i)%bc
! ... some codes
...