CODEWITHSUNDEEP
oopfortran2008
user3618395
user3618395

Reputation: 3

How to use polymorphic data type as attribute of another data type in Fortran

I have created a class called 'element' that has several attributes and type-bound procedures. One of the attributes is an abstract class type 'kin' that has two inherited type 'kin1' and 'kin2'. I would like to be able to assign 'kin1' or 'kin2' as a attribute to the object 'element' at run time using the constructor depending on the inputs. The objective is to have a list of elements, each one with element%kin being either 'kin1' type or 'kin2' type.

Module element

module element

use kin

implicit none

type,public :: element_type
    class(kin_type),allocatable :: kin
contains
    procedure,pass(this), private :: set_kin
    procedure,pass(this), public  :: get_kin
end type element_type

interface element_type
    module procedure element_type_constructor
end interface element_type

contains

type (element_type) function element_type_constructor(kin)
    implicit none             
    class(kin_type),allocatable,  intent (in) :: kin    
    call element_type_constructor%set_kin(kin)
end function element_type_constructor

! my try of set_kin
subroutine set_kin(this,kin)
implicit none
class(element_type), intent(inout) :: this
class(kin_type),allocatable, intent(in) :: kin
this%kin = kin
end subroutine

end module element

Module kin

module kin implicit none private

type,abstract :: kin_type
end type kin_type

type,public, extends(kin_type) :: kin1_type
    private
    integer :: data1
contains
    procedure,pass(this),private :: set_data1
    procedure,pass(this),public  :: get_data1
    procedure,pass(this),public  :: print =>print_kin1
end type kin1_type

type,public, extends(kin1_type) :: kin2_type
    private
    real :: data2
contains
    procedure,pass(this),private :: set_data2
    procedure,pass(this),public  :: get_data2
    procedure,pass(this),public  :: print =>print_kin2
end type kin2_type

! constructor interface kin1_type
interface kin1_type
    module procedure kin1_type_constructor
end interface kin1_type

! constructor interface kin2_type
interface kin2_type
    module procedure kin2_type_constructor
end interface kin2_type

contains

! constructor kin1_type
type (kin1_type) function kin1_type_constructor(data1)
    implicit none
    integer,          intent (in) :: data1                
    class(kin1_type), intent (in) :: kin    
    call kin1_type_constructor%set_data1(data1)
end function kin1_type_constructor

! constructor kin2_type
type (kin2_type) function kin1_type_constructor(data1,data2)
    implicit none
    integer,          intent (in) :: data1 
    real,             intent (in) :: data2               
    class(kin2_type), intent (in) :: kin    
    call kin2_type_constructor%set_data1(data1)
    call kin2_type_constructor%set_data2(data2)
end function kin2_type_constructor


! Example of set subroutine
subroutine set_data1(this,data1)
    class(kin1_type),intent(inout) :: this    
    integer,         intent(in)    :: data1
    this%data1 = data1
end subroutine set_data1

! other procedures...

end module kin

Program

program test

use element
use kin

implicit none
type(element_type) :: thisElement
type(kin1_type)    :: thisKin1

! constructor for thisKin1
thisKin1 = kin1_constructor(data1 = 1)

! constructor for thisElement
thisElement = element_type_constructor(kin = thisKin1)

! Check kin structure and values
call thisElement%kin%print

end program

Error

I receive the following error during the run of the element_type_constructor subroutine: Program received signal SIGSEGV: Segmentation fault - invalid memory reference.

Upvotes: 0

Views: 39

Answers (1)

dev-zero
dev-zero

Reputation: 81

I can't comment yet, so here it goes as a first answer: the provided code is unfortunately incomplete. Furthermore, the vendor and version of the compiler is missing, which makes it really hard to guess what the actual problem is.

"Fixing" the code to get the following example shows that it is in principle working:

kin.f90:

module kin
    implicit none
    private

    type,abstract,public :: kin_type
    contains
        procedure(print_iface), deferred :: print
    end type kin_type

    type,public, extends(kin_type) :: kin1_type
        private
        integer :: data1
    contains
        procedure,pass(this),private :: set_data1
        procedure,pass(this),public :: print => print_kin1
    end type kin1_type

    ! constructor interface kin1_type
    interface kin1_type
        module procedure kin1_type_constructor
    end interface kin1_type

    abstract interface
        subroutine print_iface(this)
            import kin_type
            class(kin_type), intent(in) :: this
        end subroutine
    end interface
contains

    ! constructor kin1_type
    type (kin1_type) function kin1_type_constructor(data1)
        implicit none
        integer,          intent (in) :: data1
        call kin1_type_constructor%set_data1(data1)
    end function kin1_type_constructor

    ! Example of set subroutine
    subroutine set_data1(this,data1)
    class(kin1_type),intent(inout) :: this
        integer,         intent(in)    :: data1
        this%data1 = data1
    end subroutine set_data1

    subroutine print_kin1(this)
        class(kin1_type),intent(in) :: this
        print *, this%data1
    end subroutine print_kin1

end module kin

element.f90:

module element
    use kin, only: kin_type

    implicit none

    type,public :: element_type
        class(kin_type), allocatable :: kin
    contains
        procedure,pass(this), private :: set_kin
    end type element_type

    interface element_type
        module procedure element_type_constructor
    end interface element_type
contains

    type (element_type) function element_type_constructor(kin)
        implicit none
        class(kin_type), intent (in) :: kin
        call element_type_constructor%set_kin(kin)
    end function element_type_constructor

    ! my try of set_kin
    subroutine set_kin(this,kin)
        implicit none
        class(element_type), intent(inout) :: this
        class(kin_type), intent(in) :: kin
        this%kin = kin
    end subroutine
end module element

main.f90:

program test

    use element
    use kin

    implicit none
    type(element_type) :: thisElement
    class(kin_type), allocatable :: thisKin1

    ! constructor for thisKin1
    thisKin1 = kin1_type(data1 = 1)

    ! constructor for thisElement
    thisElement = element_type(kin = thisKin1)

    call thisElement%kin%print()
end program

Building it with gfortran 7.4.0 and runnig it yields:

$ gfortran -o prog kin.f90 element.f90 main.f90
$ ./prog 
           1
$

One notable difference to what was provided is the deferred print procedure on the abstract type since it is being called via an attribute defined as a class(kin_type). Unfortunately that does not explain the cited error.

Upvotes: 0

Related Questions