Fortran: указатель на различные функции с массивом

Question

Я начинаю эту ветку, потому что хочу узнать, как успешно использовать один и тот же указатель, чтобы служить в качестве псевдонимов различных функций с множеством значений, скажем, f1 и f2, последовательно.

Вот неудачный код, чтобы проиллюстрировать, что я хочу. Благодарю. Ли

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

Для указателя на функцию, которая возвращает массив, вы хотите иметь интерфейс, чтобы описать указатель на функцию, которая возвращает массив.

Вот пример того, как установить указатели на функции, которые могли бы установить вас в правильном направлении: How to alias a function name in Fortran

Edit: ОК, вот несколько примеров исходного кода:

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