How to pass function name in subroutine/function

Question

My problem is to pass the names of a series of functions contained in a module to a subroutine in a do loop.

I post part of my code. The modules are in two separate files compared to the main.

%%% FILE testKer_mod.f90

module kernel
  implicit none
  contains

  ! POLYNOMIAL 
  function poly(x, ts, ndim, a, param1, param2)
     integer, intent (in) :: ndim
     real*8, dimension(ndim), intent(in) :: x
     real*8, dimension(ndim), intent(in) :: ts
     real*8, intent(in) :: a, param1, param2
     real*8 :: r
     real*8 :: poly 

     r = (x(1:ndim) - ts(1:ndim))

     poly = r**(.5*a)

   end function poly

   ! GAUSSIAN
   function gauss(x, ts, ndim, a, gamma, param2)
      integer, intent (in) :: ndim 
      real*8, dimension(ndim), intent(in) :: x
      real*8, dimension(ndim), intent(in) :: ts
      real*8, intent(in) :: a, param2, gamma
      real*8 :: r
      real*8 :: gauss

      r = (x(1:ndim) - ts(1:ndim))

     gauss = exp(-(gamma*r)**a)

  end function gauss

end module kernel

%%%

%%% FILE testSRBF_mod.f90

  module srbf
    implicit none
    contains    

  subroutine weigth(nx, x, nts, ts, ndim, s, kernel, StocPar, param, coe, mat)
    integer :: i,j,k,l,m,n
    integer :: info
    integer :: nx, nts, ndim
    integer, dimension(nts) :: ipiv 
    real*8, dimension(nts) :: w
    real*8, dimension(nts) :: s
    real*8, dimension(2) :: param
    real*8, dimension(nx,ndim) :: x
    real*8, dimension(nts,ndim) :: ts
    real*8, dimension(nx,nts) :: phi, mat
    real*8, dimension(nts) :: coe
    real*8 :: stocPar

    interface
     real*8 function kernel(x1, x2, n3, stov, p1, p2)
       integer, intent (in) :: n3
       real*8, dimension(n3), intent(in) :: x1
       real*8, dimension(n3), intent(in) :: x2
       real*8, intent(in) :: stov, p1, p2
     end function kernel
    end interface

    do i = 1, nx
      do j = 1, nts
          phi(i,j) = kernel(x(i,1:ndim), ts(j,1:ndim), ndim, stocPar, param(1), param(2))
      end do
    end do

    w = s       
    mat = phi   
    call DGESV(nts,1,mat,nts,ipiv,w,nts,info) 
    coe = w
  end subroutine weigth 
end module srbf

%%%

%%% MAIN PROGRAM test.f90
program MKRBF

   use kernel
   use srbf

   implicit none

   !real*8 :: SelKer
   integer :: i,j,k
   integer, parameter :: n = 3
   integer, parameter :: nKer = 2
   real*8, dimension(2,2) :: ParBound, auxpar
   real*8, dimension(2) :: Bound
   real*8, dimension(n) :: Var, func
   real*8, dimension(n,nKer) :: coe
   real*8, dimension(n,n) :: mat

   !external SelKer

   interface
     real*8 function SelKer(ind)
       integer, intent (in) :: ind
     end function SelKer
   end interface

   Bound(1) = 0
   Bound(2) = 5

   ParBound(1,1) = 1 
   ParBound(1,2) = 5
   ParBound(2,1) = 1 
   ParBound(2,2) = 5

   auxpar(1,1) = 0 
   auxpar(1,2) = 0
   auxpar(2,1) = 1 
   auxpar(2,2) = 1

   var(:) = (/ 0., 2.5, 5. /)

   do i = 1, n
       func(i) = cos(3*Var(i)) * exp(-.25*Var(i));
   end do

   do i = 1, nKer
       call weigth(n,Var,n,Var,1,func,SelKer(i),2.0D0,auxpar,coe,mat)
   end do
end program MKRBF

function SelKer(indx)
  integer, intent(in) :: indx
  real*8 :: SelKer

  select case (indx)
  case (1)
    SelKer = poly
  case (2)
    SelKer = gauss
  end select
  return
end function SelKer

%%%

I tried both with interface and with external but the program gives me the same error:

gfortran testKer_mod.f90 testSRBF_mod.f90 test.f90 -llapack -o test
test.f90:46:38:

    call weigth(n,Var,n,Var,1,func,SelKer(i),2.0D0,auxpar,coe,mat)
                                  1
 Error: Expected a procedure for argument 'kernel' at (1)

How can I fix it?

score 2 · Accepted Answer · answered Feb 23 '19 at 11:40

Looking at the interface block in the main program

interface
  real*8 function SelKer(ind)
    integer, intent (in) :: ind
  end function SelKer
end interface

SelKer is a function with real*8 result.¹ SelKer(i) is such a function result. Crucially, SelKer(i) isn't a function with real*8 result, but such a real*8 value. weigth is expecting the argument for kernel to be a function (which is a procedure). This is the error message.

Coming to how the external function SelKer is implemented: we see such things as

SelKer = poly

In the function poly isn't the function poly in the module kernel but a local (default) real scalar variable (with undefined value). Note the lack of implicit none in the function.

Instead, you want to be looking to be using procedure pointers. This is a broad topic, so I'll just give an indication of the approach.

Move SelKer to be a procedure in the module kernel (removing the corresponding interface block from the main program).
Declare the function result SelKer to have type procedure(poly).
Use pointer assignment for the result, like SelKer => gauss.

There are other, perhaps better ways, to structure such a program. In particular, many would advise against using procedure pointer function results.

¹ real*8 isn't standard Fortran.

Thank you for the prompt reply, but I do not know how to use the procedure pointer. Can you give me a step-by-step guideline for my case? — Luca Montagliani, Feb 23 '19 at 15:13
I see you've asked another question about this, before I had chance to write a more complete outline. I'll leave this answer as it is: it's usually a better way to learn by looking elsewhere and trying something. — francescalus, Feb 24 '19 at 13:31
After your guidelines on how to solve my problem I searched on internet and other posts. However, even for the hurry to solve, I did not find solutions and therefore I opened a new post. Thank you for the answer you gave me anyway because in this way I understood that was the problem and then formulate the questioni better. — Luca Montagliani, Feb 24 '19 at 19:02

How to pass function name in subroutine/function

1 Answers1