From: Nick Fort on
Is it possible to pass an overloaded function as an argument to a
subroutine/other procedure? (I'm talking about Fortran90+ here.)

For example, say I have function that is overloaded to accept one or two
inputs. I then want to send use this function as an argument in a
minimisation subroutine. Depending on the number of arguments in
subroutine, I would like the program to choose whether to use the one-
or two-input version of the function on which to perform the
minimsation.

So say we have

SUBROUTINE minim(minval,func,a,b)

where b is an optional argument. minval has intent(out), func has an
explicit interface (as shown below), and a and b have intent(in).

and the overloaded function

interface func
function func1(x,a)
<declarations, etc.>
end function

function func2(x,a,b)
<declarations, etc.>
end function
end interface

I've tried to compile a program that does this, but both g95 and
gfortran complained. I can't remember the exact error (it was a few days
ago, and I've since changed the code to use a workaround), but I think
it said something about an ambiguous interface. I guess I can understand
that, but surely there's some way of doing this. The way I see it, the
above would be the most elegant way of achieving this flexibility.

Any comments/input would be appreciated!

Regards,
NickFort
From: Richard Maine on
Nick Fort <nickfort.newsgroups(a)gmail.com> wrote:

> Is it possible to pass an overloaded function as an argument to a
> subroutine/other procedure? (I'm talking about Fortran90+ here.)

No.

(And just as a terminology nit, the Fortran term is "generic" function
rather than "overloaded").

Generic functions are designed to be resolvable at compile time. That's
not easily consistent with passing them as actual arguments. Anyway,
that's my simple attempt at explaining why. In any case, no you can't do
it.

> For example, say I have function that is overloaded to accept one or two
> inputs....

For that kind of distinction, optional arguments could probably do what
you want.

> where b is an optional argument. minval has intent(out), func has an
> explicit interface (as shown below), and a and b have intent(in).
>
> and the overloaded function
>
> interface func
> function func1(x,a)
> <declarations, etc.>
> end function
>
> function func2(x,a,b)
> <declarations, etc.>
> end function
> end interface

Well, I would not precisely say that func has an explicit interface.
That concept doesn't really apply to generic procedures. It is func1 and
func2 that have explicit interfaces.

Anyway, if you want to do something like this, I'd say instead to make
func a specific function with two arguments, the second being optional.
Then inside of func, you can do something like

if (present(b)) then
func = func2(x,a,b)
else
func = func1(x,a)
endif

There are other ways to go about it, but that's one. (Another starts
with having the second argument to func being an array, which might be
of size either 1 or 2).

--
Richard Maine | Good judgment comes from experience;
email: last name at domain . net | experience comes from bad judgment.
domain: summertriangle | -- Mark Twain
From: Nick Fort on
In article <1jl9e8e.nizs24s6dh70N%nospam(a)see.signature>,
nospam(a)see.signature says...
>
> Nick Fort <nickfort.newsgroups(a)gmail.com> wrote:
>
> > Is it possible to pass an overloaded function as an argument to a
> > subroutine/other procedure? (I'm talking about Fortran90+ here.)
>
> No.
>
> (And just as a terminology nit, the Fortran term is "generic" function
> rather than "overloaded").
>
> Generic functions are designed to be resolvable at compile time. That's
> not easily consistent with passing them as actual arguments. Anyway,
> that's my simple attempt at explaining why. In any case, no you can't do
> it.
>
> > For example, say I have function that is overloaded to accept one or two
> > inputs....
>
> For that kind of distinction, optional arguments could probably do what
> you want.
>
> > where b is an optional argument. minval has intent(out), func has an
> > explicit interface (as shown below), and a and b have intent(in).
> >
> > and the overloaded function
> >
> > interface func
> > function func1(x,a)
> > <declarations, etc.>
> > end function
> >
> > function func2(x,a,b)
> > <declarations, etc.>
> > end function
> > end interface
>
> Well, I would not precisely say that func has an explicit interface.
> That concept doesn't really apply to generic procedures. It is func1 and
> func2 that have explicit interfaces.
>
> Anyway, if you want to do something like this, I'd say instead to make
> func a specific function with two arguments, the second being optional.
> Then inside of func, you can do something like
>
> if (present(b)) then
> func = func2(x,a,b)
> else
> func = func1(x,a)
> endif

Hi Richard,

Thanks for the reply. Right, "generic procedure" it is! I've seen them
referred to as "overloaded" on the net, which is where I picked that up.

The "workaround" I mentioned was exactly what you said with the

if (present(b)) then
func = func2(x,a,b)
else
func = func1(x,a)
endif

The only thing I don't like about this approach is that one of the
additional parameters I may or may not pass to func1 or func2 is an
assumed-shape array, such that they require an explicit interface, as I
can't simply use the "external" attribute. Therefore, both func1 and
func2 will be described by this interface in the "minim" subroutine:

interface
function func(x,a,b)
implicit none
real, dimension(:), intent(in), optional :: b
<other declarations>
end function
end interface

While this does work, it requires the redundant definition of the
optional "b" in func1 itself, which is never used in that function, such
that it'll match the interface. Is this right, or can optional arguments
that exist in the interface not exist in the actual function? This
possibility just popped into my mind, so I haven't had a chance to try
it myself yet.

Regards,
NickFort
From: Richard Maine on
Nick Fort <nickfort.newsgroups(a)gmail.com> wrote:

> if (present(b)) then
> func = func2(x,a,b)
> else
> func = func1(x,a)
> endif
>
> The only thing I don't like about this approach is that one of the
> additional parameters I may or may not pass to func1 or func2 is an
> assumed-shape array, such that they require an explicit interface, as I
> can't simply use the "external" attribute.

I recommend having an explicit interface for everything anyway for many
reasons. But that aside..

> Therefore, both func1 and
> func2 will be described by this interface in the "minim" subroutine:

> interface
> function func(x,a,b)
> implicit none
> real, dimension(:), intent(in), optional :: b
> <other declarations>
> end function
> end interface

Either I missed something or you did. I don't see any way in which this
follows from what you said. Maybe you need to show more of the code to
illustrate the point. That interface describes neither func1 nor func2.
It describes func. The only place in which func1 or func2 is referenced
is from within func, which would presumably look something like

function func(x,a,b)
!-- Ideally func1 and func2 would be module procedures,
!-- and you would USE the module here to get their interfaces.
!-- Otherwise, you need an interface body as below.
implicit none
real :: func
real, intent(in) :: x,a
real, intent(in), optional :: b(:)
!-- If you didn't get the interfaces for func1 and func2 from
!-- a module, then
interface
function func1(x,a,b)
implicit none
real :: func1
real, intent(in) :: x,a
real, intent(in), optional :: b(:)
end function func1
function func2(x,a)
implicit none
real :: func1
real, intent(in) :: x,a
end function func2
end interface

if (present(b)) then
func = func2(x,a,b)
else
func = func1(x,a)
end if

> While this does work, it requires the redundant definition of the
> optional "b" in func1 itself, which is never used in that function, such
> that it'll match the interface.

I think you missed the point. Func1 has no need of the b argument as it
is never invoked with it. That's what the IF block is for.

> Is this right, or can optional arguments
> that exist in the interface not exist in the actual function?

No. No. No. Never.

The whole point of why an explicit interface is needed for many things
(including optional arguments and assumed shape dummies) is that the
invoker needs to know what the invoked procedure looks like in order to
do the invocation correctly. If you lie to the invoker by telling it
that the invoked procedure looks different than it actually does, all
kinds of bad things can happen. Don't do that. (Probably the worst bad
thing that can happen is that it might happen to appear to work in some
cases on some compilers, which could lead you down a painful path).

--
Richard Maine | Good judgment comes from experience;
email: last name at domain . net | experience comes from bad judgment.
domain: summertriangle | -- Mark Twain
From: Ian Harvey on
On 8/07/2010 6:31 AM, Nick Fort wrote:
...stuff about having variable number of arguments in objective function...

If you are feeling brave and have a compiler that supports it (F2003)
without too many bugs and it is not a nice day outside, then another
architectural path for infinitely variable arguments to objective
functions is to use types bound procedures.


MODULE SolverStuff
IMPLICIT NONE
PRIVATE
PUBLIC :: MySpecialSolver

! System descriptions to be "solved" should extend this
TYPE, ABSTRACT, PUBLIC :: System
CONTAINS
! Systems descriptions must define this type bound procedure
PROCEDURE(ObjectiveFn), PASS(obj), DEFERRED :: EvaluateMePlease
END TYPE System

ABSTRACT INTERFACE
FUNCTION ObjectiveFn(obj, x) RESULT(y)
IMPORT
IMPLICIT NONE
CLASS(System), INTENT(IN) :: obj
REAL, INTENT(IN) :: x(:)
REAL :: y
END FUNCTION ObjectiveFn
END INTERFACE
CONTAINS
SUBROUTINE MySpecialSolver( system_description, starting_coord, &
best_coord, best_value )
CLASS(System), INTENT(IN) :: system_description
REAL, INTENT(IN) :: starting_coord(:)
REAL, INTENT(OUT) :: best_coord(:)
REAL, INTENT(OUT) :: best_value
!****
! This is as good as any of the solvers I've written...
CALL RANDOM_NUMBER(best_coord)
best_coord = best_coord + starting_coord
! This may involve some "virtual function call overhead".
! But in the real world its not normally a problem
best_value = system_description%EvaluateMePlease(best_coord)
END SUBROUTINE MySpecialSolver
END MODULE SolverStuff

MODULE MySystemModel
USE SolverStuff, ONLY: System
IMPLICIT NONE
PRIVATE

TYPE, EXTENDS(System), PUBLIC :: MySystemType
REAL :: some_param
REAL :: another_variable
! as many as you'd like, whatever type, rank, kind or colour...
CONTAINS
PROCEDURE :: EvaluateMePlease => my_system_eval
END TYPE MySystemType

! Different system or model? Just define a new derived type.
! TYPE, EXTENDS(System) :: SomeOtherSystemType
! REAL :: totally_different2
! CONTAINS
! PROCEDURE :: EvaluateMePlease => some_other_eval
! END TYPE MySystemType

CONTAINS
FUNCTION my_system_eval(obj, x) RESULT(y)
CLASS(MySystemType), INTENT(IN) :: obj
REAL, INTENT(IN) :: x(:)
REAL :: y
!****
! My model, years of work...
y = obj%some_param * SUM(x) - obj%another_variable
END FUNCTION my_system_eval
END MODULE MySystemModel

PROGRAM WorkItOut
USE SolverStuff
USE MySystemModel
IMPLICIT NONE

TYPE(MySystemType) :: sys_desc
REAL :: x_final(2)
REAL :: y_final
!****
! set up the system description
sys_desc%some_param = 1.0
sys_desc%another_variable = 2.0
! Solve/optimise/whatever...
CALL MySpecialSolver(sys_desc, [0.0, 0.0], x_final, y_final)
WRITE (*, *) 'Best coord was:', x_final, 'with value:', y_final
END PROGRAM WorkItOut