Best way to generate a variable type fortran array (each element can be a different type)

Question

Following a previous question I had (Fortran TYPE inheritance on runtime (declared by user)), I am using a factory method to generate an array of different types. Below is a simplified version of what I'm doing,

module multiarray
use iso_fortran_env, only: real64
implicit none

integer, parameter :: dp = real64

! abstract list type
type, abstract :: list
  contains
    procedure(in),  deferred, pass(self) :: addval ! add a variable
    procedure(out), deferred, pass(self) :: getval ! extract variable
end type

abstract interface
  subroutine in(self,val)
    import :: list
    implicit none
    class(list), intent(inout) :: self
    class(*), intent(in) :: val
  end subroutine  
  
  subroutine out(self,val)
    import :: list
    implicit none
    class(list), intent(in) :: self
    class(*), intent(out) :: val
  end subroutine    
end interface

! real(dp) element  extension
type, extends(list) :: real_num
  real(dp) :: var
  contains
    procedure, pass(self) :: addval => addreal
    procedure, pass(self) :: getval => getreal    
end type

!  similar for character, logical, etc types 
...

! wrapper
type wrapper
  class(list), ALLOCATABLE :: arg
end type

contains

! real(dp) subroutines 
subroutine addreal(self,val)
  implicit none
  class(real_num), intent(inout) :: self
  class(*), intent(in) :: val
  select type(val)
    type is (real(dp))
      self%var = val
  end select  
end subroutine

subroutine getreal(self,val)
  implicit none
  class(real_num), intent(in) :: self
  class(*), intent(out) :: val
  select type(val)
    type is (real(dp))
      val = self%var
  end select  
end subroutine

! similar for character, logical, etc types  
...

! factory method
function get_list(val) result(pt)
  class(*), intent(in) :: val
  class(list), allocatable :: pt
  
  select type(val)
    type is (real(dp))
      allocate(real_num :: pt)
    type is (character(*))
      ...      
  end select   
  
end function

end module

I use the wrapper type to generate an allocatable array of type list

type(wrapper) :: A(5)
real(dp) :: x
A(1)%arg = get_list(90.d0)  ! Set A(1) as type real     
call A(1)%arg%addval(90.d0) ! A(1) is a real of value 90
call A(1)%arg%getval(x)     ! set x = A(1) to use elsewhere    

The variable var is defined as a generic class in the abstract interface, it can be of real, character, logical, etc type. I then use a select type construct to match the addval=>addreal subroutine argument since var is of type class(*) in the abstract interface.

Is there a way to define an interface inside the abstract interface (nested), in a way that I don't need to have the select type in addreal (since I already know it's input needs to be a real type)? Or is there a better way, simpler way, to achieve what I'm trying to do with the variable type array? Thanks!

Answer 1

I think you don't want to have both class(*) inputs and an abstract base class. I think you want to have either one:

• a non-polymorphic container class that can contain any (class(*)) element types, for example, a key-value pair in a dictionary;
• a polymorphic container class if a limited set of types should later have a shared API.

In your case it seems you want maximum flexibility, I would vote for having a unique container class and making usage of class(*), like in the following example I've just made up:

! FP 2022-07-25
module myList
        use iso_fortran_env
        implicit none

        type, public :: listElement 
            class(*), allocatable :: x

            contains 
               procedure :: set
               procedure :: get_any
               procedure :: get_typed
               procedure, private :: print
               generic :: write(formatted) => print 
               
        end type listElement

        contains

        ! Map accepted types
        elemental logical function isAccepted(val)
            class(*), intent(in) :: val

            select type (input=>val)
               type is (real(real32)); isAccepted = .true.
               type is (character(*)); isAccepted = .true.
               class default;          isAccepted = .false.
            end select
        end function isAccepted
        
        ! Print value
        subroutine print(this, unit, iotype, v_list, iostat, iomsg) 
           class(listElement), intent(in) :: this 
           integer, intent(in) :: unit
           character(*), intent(in) :: iotype
           integer, intent(in)  :: v_list(:)
           integer, intent(out) :: iostat
           character(*), intent(inout) :: iomsg

           if (.not.allocated(this%x)) then 
              write(unit,*,iostat=iostat) 'null'
           else
              select type (myVar => this%x)
                 type is (real(real32)); write(unit,*,iostat=iostat) myVar
                 type is (character(*)); write(unit,*,iostat=iostat) myVar
                 class default;          write(unit,*,iostat=iostat) "ERROR"
              end select
           endif

       end subroutine print 


        subroutine set(this,val)
            class(listElement), intent(inout) :: this
            class(*), intent(in) :: val

            integer :: ierr
            deallocate(this%x,stat=ierr) ! force deallocate
            allocate(this%x,source=val)
        end subroutine set

        ! Can be anything, but "val" must be declared "class(*), allocatable"
        subroutine get_any(this,val)
            class(listElement), intent(in) :: this
            class(*), intent(out), allocatable :: val

            allocate(val,source=this%x)
        end subroutine get_any

        subroutine get_typed(this,val)
            class(listElement), intent(in) :: this
            class(*), intent(out) :: val ! has a type that can't change
          
            if (.not.isAccepted(val)) stop ' trying to return value to a class thats not supported '
            if (.not.allocated(this%x)) return ! will return garbage

            select type (outVal => val)
               type is (real(real32)); 
                   select type (thisVal => this%x)
                      type is (real(real32)); outVal = thisVal
                      type is (real(real64)); outVal = real(thisVal,real32)
                      class default; stop 'error trying to convert list element to real32'
                   end select
               type is (character(*)); 
                   select type (thisVal => this%x)
                      type is (character(*)); outVal = trim(thisVal)
                      class default; stop 'error trying to convert list element to character'
                   end select
               class default 
                  stop 'trying to return value to a class thats not accepted '
            end select

        end subroutine get_typed

end module myList

program tryList
    use myList
    implicit none
    
    type(listElement) :: A(5)
    integer :: i
    character(255) myChar
    real(real32) :: r32
    real(real64) :: r64


    call A(1)%set(123.45)
    call A(2)%set("hello world!")
    call A(3)%set(123.45d0)

    do i=1,3
      print *, 'A(',i,')=',A(i)
    end do

    call A(1)%get_typed(r64); print *, 'r64=',r64
    call A(1)%get_typed(r32); print *, 'r32=',r32
    call A(2)%get_typed(myChar); print *, 'myChar=',myChar

    call A(2)%get_typed(r32) ! stop on error
end program

Notice that:

• In general, this should work with any variables (class(*)), but if you want to use the fully polymorphic interface, the input variable must be defined as class(*), allocatable anywhere else, so, not exactly handy.
• You want to have some helper routines and/or an enumerator type that help you map/handle all types you want to be contained, this example is just a stub.