function - subprogramas - return en fortran

Fortran-Devuelve una función anónima de la subrutina

Question

Estoy intentando generalizar una llamada de función desde una subrutina. Entonces mi idea es algo como esto

if (case1) then
call MainSubroutine1(myFun)
elseif (case2)
call MainSubroutine2(myFun)
end if
do i = 1,4
data = myFun(i)
end do

Me doy cuenta de que esto es un poco vago, pero no estoy seguro si esto es posible.

Gracias,

John

editar 1/31/14 7:57 AM

Lo siento por la forma vaga en que expresé esto. Estaba pensando algo similar a lo que @haraldki hizo, pero esperaba poder definir una función anónima dentro de MainSubroutine1 y MainSubroutine2 y transferir esa definición al código principal.

Esto se debe a que myFun depende de diferentes distribuciones estiradas (Gaussian y Fermi-Dirac) y no quiero tener una función que solo llame a una función con una constante lanzada.

es posible?

Gracias de nuevo.

John

Answer 1

La respuesta a su pregunta simplemente es: no, no puede devolver una función anónima. Esto se debe a que, como dice @VladimirF en los comentarios, no hay funciones anónimas en Fortran. Como dicen los comentarios, sin embargo, los indicadores de procedimiento son bastante pasables.

Continua la especulación masiva que es útil como una forma de evitar el requisito de la función anónima.

Deduzco que le gustaría hacer algo como

subroutine MainSubroutine1(fptr)
procedure(func), pointer, intent(out) :: fptr
! Calculate parameterization for your "anonymous" function
fptr => anon_parameterized
contains
real function anon_parameterized(i)
integer, intent(in) :: i
! Use the parameterization
anon_parameterized = ...
end function
end subroutine

y no quieres hacer

subroutine MainSubroutine1(fptr)
procedure(func), pointer, intent(out) :: fptr
fptr => Gaussian
end subroutine
real function Gaussian(i)
integer, intent(in) :: i
! Calculate parameterization
Gaussian = Gaussian_parameterized(i, ...)
contains
function Gaussian_parameterized(i, ...)
integer, intent(in) :: i
!... other intent(in) parameters
end function
end subroutine

Tenga en cuenta que estos no son internos, ya que pasar punteros a cosas internas en otros lugares aún no está bien implementado (como una función de F2008), y es complicado. Pasar un puntero a un procedimiento interno para obtener la asociación de host me asusta.

Si mi inferencia es correcta, existe la posibilidad de usar variables de módulo para almacenar la parametrización, permitiendo de nuevo que la llamada final "parametrizada" no sea interna a MainSubroutine1 .

Sin embargo, es posible que desee evitar las variables del módulo, en cuyo caso puede considerar pasar la parametrización junto con la llamada a la función:

procedure(func), pointer :: myFun => null()
if (case1) then
call MainSubroutine1(myFun)
else if (case2)
call MainSubroutine2(myFun)
end if
if (.not.associated(myFun)) STOP ":("
data = myFun(1, par1, par2)

Ah, pero no sabes con certeza qué parámetros requiere la función no parametrizada myFun , por lo que tu interfaz está rota. ¿No es así?

Que luego conduce al polimorfismo.

module dists
type, abstract :: par_type
end type par_type
type, extends(par_type) :: par_gaussian
real :: mu=5.2, sigma=1.2
end type par_gaussian
type, extends(par_type) :: par_fermi_dirac
real :: eps=11.1, mu=4.5
end type par_fermi_dirac
abstract interface
real function func(i, pars)
import par_type
integer, intent(in) :: i
class(par_type), intent(in) :: pars
end function func
end interface
contains
real function gaussian(i, pars)
integer, intent(in) :: i
class(par_type), intent(in) :: pars
select type (pars)
class is (par_gaussian)
print*, "Gaussian", pars%mu, pars%sigma
gaussian = pars%mu+pars%sigma
end select
end function gaussian
real function fermi_dirac(i, pars)
integer, intent(in) :: i
class(par_type), intent(in) :: pars
select type (pars)
class is (par_fermi_dirac)
print*, "Fermi-Dirac", pars%eps, pars%mu
fermi_dirac = pars%eps+pars%mu
end select
end function fermi_dirac
subroutine sub1(fptr, pars)
procedure(func), pointer, intent(out) :: fptr
class(par_type), intent(out), allocatable :: pars
fptr => gaussian
allocate(par_gaussian :: pars)
end subroutine sub1
subroutine sub2(fptr, pars)
procedure(func), pointer, intent(out) :: fptr
class(par_type), intent(out), allocatable :: pars
fptr => fermi_dirac
allocate(par_fermi_dirac :: pars)
end subroutine sub2
end module dists
program prog
use dists
implicit none
class(par_type), allocatable :: pars
procedure(func), pointer :: myfun
call sub1(myfun, pars)
print*, myfun(i, pars)
call sub2(myfun, pars)
print*, myfun(i, pars)
end program prog

Sin embargo, eso es toda especulación.