Can I mimic multiple passed-object dummy arguments in Fortran? - fortran

Question

I would like to write a procedure which takes two passed-object dummy arguments, such as
module m
type, abstract :: Parent
contains
procedure(f_Parent), deferred :: f
end type
abstract interface
subroutine f_Parent(foo,bar)
import Parent
implicit none
class(Parent), intent(in) :: foo
class(Parent), intent(in) :: bar
end subroutine
end interface
type, extends(Parent) :: Child
contains
procedure, public :: f => f_Child
end type
contains
subroutine f_Child(foo,bar)
implicit none
class(Child), intent(in) :: foo
class(Child), intent(in) :: bar
end subroutine
end module
but this is not allowed by the Fortran standard, as bar is not a passed-object dummy argument, and so must be class(Parent) and not class(Child).
My current solution is
subroutine f_Child(foo,bar)
implicit none
class(Child), intent(in) :: foo
class(Parent), intent(in) :: bar
select type(bar); type is(Child)
end select
end subroutine
which works, but the select type construct is too slow, and dominates the runtime of my code (this subroutine is called many times).
I have tried having a single passed-object argument which holds both foo and bar, e.g. as an array or pointer, but this is also forbidden by the standard.
Is there any way of mimicking the behaviour of having multiple passed-object dummy arguments which does not incur the cost of a select type construct? Or maybe a faster way of getting an argument of class(Child) from class(Parent)?

Answer 1

You can do it by using single dispatch twice:
Module m
Implicit None
Type, Public, Abstract :: Parent
Contains
Procedure( i_Parent_Parent ), Public , Deferred :: f
Procedure( i_Child_Parent ), Pass( bar ), Private, Deferred :: f_c_p
Procedure( i_set ), Public , Deferred :: set
End Type Parent
Type, Public, Extends( Parent ) :: Child
Integer , Private :: data
Contains
Procedure , Public :: f => f_Child_Parent
Procedure, Pass( bar ), Private :: f_c_p => f_Child_Child
Procedure , Public :: set => f_Child_set
End Type Child
Private
Abstract Interface
Subroutine i_Parent_Parent( foo, bar )
Import :: Parent
Implicit None
Class( Parent ), Intent( In ) :: foo
Class( Parent ), Intent( In ) :: bar
End Subroutine i_Parent_Parent
Subroutine i_Child_Parent( foo, bar )
Import :: Parent, Child
Implicit None
Class( Child ), Intent( In ) :: foo
Class( Parent ), Intent( In ) :: bar
End Subroutine i_Child_Parent
Subroutine i_set( foo, data )
Import :: Parent
Class( Parent ), Intent( InOut ) :: foo
Integer , Intent( In ) :: data
End Subroutine i_set
End Interface
Contains
Subroutine f_Child_Parent( foo, bar )
Implicit None
Class( Child ), Intent( In ) :: foo
Class( Parent ), Intent( In ) :: bar
Call bar%f_c_p( foo )
End Subroutine f_Child_Parent
Subroutine f_Child_Child( foo, bar )
Implicit None
Class( Child ), Intent( In ) :: foo
Class( Child ), Intent( In ) :: bar
Write( *, * ) 'In child child foo%data = ', foo%data, ' bar%data = ', bar%data
End Subroutine f_Child_Child
Subroutine f_Child_set( foo, data )
Implicit None
Class( Child ), Intent( InOut ) :: foo
Integer , Intent( In ) :: data
foo%data = data
End Subroutine f_Child_set
End Module m
Program driver
Use m, Only : Parent, Child
Class( Parent ), Allocatable :: foo, bar
Allocate( Child :: foo )
Allocate( Child :: bar )
Call foo%set( 3 )
Call bar%set( 4 )
Call foo%f( bar )
End Program driver
ian#eris:~/work/stack$ gfortran-8 -std=f2008 -fcheck=all -Wall -Wextra dd.f90
ian#eris:~/work/stack$ ./a.out
In child child foo%data = 3 bar%data = 4
ian#eris:~/work/stack$
Whether this is quicker than select type will be implementation dependent, but I think it is cleaner.