Re: internal procedure as an actual argument

As a OO obsessive, I would immediately think of a solution based
on function pointers (for example the cray pointers of gfortran)
included in a OO integration class.

The following object-based module is a sample integration class, which
allows
to store various settings such as the solution, plus a function
pointer
to store the adress of the function to integrate.
(I am not sure that the source compiles, but this is the idea)

module integration
implicit none
public :: integration_new
public :: integration_free
public :: integration_set_integration_function
public :: integration_solve
public :: integration_get_solution
!
! Derived-type to make integration !
!
type, public :: T_INTEGRATION
private
! Address of the function to integrate
integer :: fonc_address
! Initial guess, solution, etc... comes here
double precision :: solution
end type T_INTEGRATION
contains
!
! Set the basic parameters of the optimizer.
!
subroutine integration_new ( this )
implicit none
type(T_INTEGRATION), intent(inout) :: this
!
! Initialize the fonc pointer
!
this % fonc_address = 0
end subroutine integration_new
!
! Frees memory for pointers in derived types
!
subroutine integration_free ( this )
implicit none
type(T_INTEGRATION), intent(inout) :: this
end subroutine integration_free
!
! Set the objective function to optimize
!
subroutine integration_set_integration_function ( this , new_fonc )
implicit none
type ( T_INTEGRATION ), intent(inout) :: this
interface new_fonc_interface
double precision function new_fonc ( x )
implicit none
double precision, intent(in) :: x
end function new_fonc
end interface new_fonc_interface
this % fonc_address = loc ( new_fonc )
end subroutine integration_set_integration_function
!
! Integration solver
!
subroutine integration_solve ( this )
implicit none
type ( T_INTEGRATION ), intent(inout) :: this
! Solver ...
! Here, the function can be computed with the subroutine
integration_fonc
end subroutine integration_solve
!
! Accessor to the solution
!
subroutine integration_get_solution ( this , solution )
implicit none
type ( T_INTEGRATION ), intent(inout) :: this
double precision, intent(out) :: solution
solution = this % solution
end subroutine integration_get_solution
!
! This fonction allows the integrator to compute the function
!
double precision function integration_fonc ( this , x )
implicit none
type ( T_INTEGRATION ), intent(inout) :: this
double precision, intent(in) :: x
double precision :: fonc_pointee
external fonc_pointee
pointer ( fonc_pointer , fonc_pointee )
!
! Evaluate the function
!
fonc_pointer = this % fonc_address
optim_fonc = fonc_pointee ( x )
end function integration_fonc
end module integration

The client program has to set the function by the way of the
integration_set_integration_function accessor.
The following example shows two functions :
* f1 only uses a constant parameter
* f2 get that parameter from a module.

program client_integration
implicit none
use integration, only : integration_new, &
integration_free, &
integration_set_integration_function, &
integration_solve, &
integration_get_solution
type ( T_INTEGRATION ) :: myintegration
double precision :: solution
interface
double precision function f1 ( x )
implicit none
double precision, intent(in) :: x
end function f1
double precision function f2 ( x )
implicit none
double precision, intent(in) :: x
end function f2
end interface

call integration_new ( myintegration )
call integration_set_integration_function ( myintegration , f1 )
call integration_solve ( myintegration )
call integration_get_solution ( myintegration , solution )
call integration_free ( myintegration )
end program client_integration

function f1( x )
real :: x
real, parameter :: f = 2.d0

f = exp(x*t)

end function f1

function f2( x )
use myparam, only : f
real :: x

f = exp(x*t)

end function2

module myparam
implicit none
private
real, parameter, public :: f = 2.d0
end module myparam

Indeed, these problems really are good examples for that way
of programming. It includes optimization solvers, Newton
methods, ode solvers, statistics analysis etc...

Best regards,

Michaël
.

Relevant Pages