Fortran: pointer to various array-valued functions

Question

I am starting this thread because I want to learn how to successfully use the same pointer to serve as the aliases of different array-valued functions, say, f1 and f2, sequentially.

Here is an unsuccessful code to illustrate what I want. Thanks. Lee

PROGRAM main
...
REAL(WP), POINTER, DIMENSION(:) :: p
p=>f1
print*,p(1.0_wp) ! the outcome should be 3
p=>f2
print*,p(2.0_wp) ! the outcome should be 3 1   

CONTAINS

FUNCTION f1(x)
IMPLICIT NONE
REAL(WP), TARGET :: f1
REAL(WP), INTENT(IN) :: x
f1=x+2
END FUNCTION f1    

FUNCTION f2(x)
IMPLICIT NONE
REAL(WP), TARGET :: f2(2)
REAL(WP), INTENT(IN) :: x
f2(1) = x+1
f2(2) = x-1
END FUNCTION f2

END PROGRAM main

Answer 1

For a pointer to a function that returns an array, you want to have an interface to describe a pointer to a function that returns an array.

Here is an example of how to setup function pointers that might set you in the right direction: How to alias a function name in Fortran

Edit: OK, here is some example source code:

module ExampleFuncs

   implicit none

contains

function f1 (x)
  real, dimension (:), allocatable :: f1
  real, intent (in) :: x

  allocate (f1 (1:2))
  f1 (1) = 2.0 * x
  f1 (2) = -2.0 * x

  return
end function f1


function f2 (x)
   real, dimension (:), allocatable :: f2
   real, intent (in) :: x

   allocate  (f2 (1:3))
   f2 (1) = x
   f2 (2) = x**2
   f2 (3) = x**3

   return
end function f2

end module ExampleFuncs


program test_func_ptrs

   use ExampleFuncs
   implicit none

   abstract interface
      function func (z)
         real, dimension (:), allocatable :: func
         real, intent (in) :: z
      end function func
   end interface

   procedure (func), pointer :: f_ptr

   real :: input

   do

      write (*, '( // "Input test value: ")', advance="no" )
      read (*, *) input

      if ( input < 0.0 ) then
         f_ptr => f1
      else
         f_ptr => f2
      end if

      write (*, '( "evaluate function: ", *(ES14.4) )' )  f_ptr (input)

   end do


end program test_func_ptrs