Procedure pointer to interfaced/overloaded procedure

Question

I am using procedure overloading and interfaces in order to achieve some sort of genericity in a Fortran program.
For this, I have a module which contains a number of procedures, all duplicated in order to be able to change the variable types. I also have at the beginning of the module, a series of interfaces of the type:

    interface norm
      module procedure &
          norm_r8, &
          norm_c
    end interface

Now my problem is that I am trying to reference norm using a procedure pointer, as such (in a different module):

procedure(), POINTER :: pNorm => NULL()
pNorm => norm

However, in this situation, gfortran gives me an error saying that I have an undefined reference to norm. If I point to norm_r8 or norm_c, no problem. But since the part of the code that assigns the pointer is not aware of the type of the variables that will be used when norm is called, I need to point to the generic name! Is there a way to point towards an overloaded procedure?

Answer 1

If I understand well, you want to achieve two things at one time. First, you want to use polymorphism to let the compiler call the correct routine dependent on whether you have a different type, rank, number of arguments etcetera. Second, you want to use procedure pointers to switch between different procedures that have the same interface.

I tried the same. I did not manage to set a pointer to an interface, but I managed to make an interface with pointers.

If you have a module like this

module some_module

  ! This is the abstract interface for procedure pointers.
  interface
    subroutine shape_1_interface(arg)
      implicit none
      real, intent(in) :: arg
    end subroutine shape_1_interface
    subroutine shape_2_interface(arg)
      implicit none
      integer, intent(in) :: arg
    end subroutine shape_2_interface
  end interface

contains

  subroutine routine_shape_1_implementation_1(arg)
    implicit none
    real, intent(in) :: arg
    write(*,*) "Arg is real",arg
    write(*,*) "Implementation 1"
  end subroutine routine_shape_1_implementation_1

  subroutine routine_shape_2_implementation_1(arg)
    implicit none
    integer, intent(in) :: arg
    write(*,*) "Arg is int",arg
    write(*,*) "Implementation 1"
  end subroutine routine_shape_2_implementation_1

  subroutine routine_shape_1_implementation_2(arg)
    implicit none
    real, intent(in) :: arg
    write(*,*) "Arg is real",arg
    write(*,*) "Implementation 2"
  end subroutine routine_shape_1_implementation_2

  subroutine routine_shape_2_implementation_2(arg)
    implicit none
    integer, intent(in) :: arg
    write(*,*) "Arg is int",arg
    write(*,*) "Implementation 2"
  end subroutine routine_shape_2_implementation_2

  subroutine routine_shape_1_implementation_3(arg)
    implicit none
    real, intent(in) :: arg
    write(*,*) "Arg is real",arg
    write(*,*) "Implementation 3"
  end subroutine routine_shape_1_implementation_3

  subroutine routine_shape_2_implementation_3(arg)
    implicit none
    integer, intent(in) :: arg
    write(*,*) "Arg is int",arg
    write(*,*) "Implementation 3"
  end subroutine routine_shape_2_implementation_3

end module some_module

then you can do in your main program:

program main

  use some_module

  implicit none

  procedure(shape_1_interface), pointer :: routine_shape_1
  procedure(shape_2_interface), pointer :: routine_shape_2

  interface routine
    procedure routine_shape_1
    procedure routine_shape_2
  end interface routine

  routine_shape_1 => routine_shape_1_implementation_1
  routine_shape_2 => routine_shape_2_implementation_1

  call routine(4)

  routine_shape_1 => routine_shape_1_implementation_2
  routine_shape_2 => routine_shape_2_implementation_2

  call routine(4.0)

end program main

It is a pity that when you want to set the pointers to a different implementation, you have to do that for all shapes, but the good thing is that you can just call 'routine' and you automatically get the desired function.

This is the output:

Arg is int           4
Implementation 1
Arg is real   4.00000000000000     
Implementation 2

Answer 2

As far as I can tell, a procedure pointer is not allowed to point at a generic interface. The standard only mentions procedures with the EXTERNAL attribute, a module procedures, or certain intrinsic procedures may be associated with a procedure pointer (C1220, ISO/IEC 1539-1:2010). Gfortran also issues a helpful error message for your case:

Error: Procedure pointer target 'norm' at (1) must be either an intrinsic, 
       host or use associated, referenced or have the EXTERNAL attribute

It also makes sense that you cannot associate to an interface, but only a procedure. An interface is only used in the procedure(INTERFACE) statement to give an explicit interface to the procedures it can point at.

This shouldn't be a showstopper for you, as the purpose of a generic interface can negate your need for a pointer. As long as all potential calls the pointer would be used for are unique in type, kind, rank and number of arguments (so the compiler can differentiate between them), you can just add all of them to a single generic interface and call that in lieu of the pointer. Alternatively you could use a select type() construct to selectively associate your pointer with the specific procedure for your type to avoid needing to associate with a generic interface.

---

Here is an example of a wrapper procedure to assign the pointer to a specific procedure based on an argument type

subroutine get_proc_ptr(pp, arg)
  implicit none
  procedure(), pointer, intent(out) :: pp
  class(*), intent(inout) :: arg

  select type(arg)
    type is (real(kind=kind(1d0)))
       pp => norm_r8
    type is (real)
       pp => norm_r
    type is (integer)
       pp => norm_i
    type is (complex)
       pp => norm_c
    class default
       pp => null()
  end select
end subroutine

Which can be made use of like this:

real(kind=kind(1d0)) :: arg_r8
procedure(), pointer :: pNorm => null()

arg_r8 = 4.0123456789d30

call get_proc_ptr(pNorm, arg_r8)
call pNorm(arg_r8)

Here is a complete compilable example:

module proc
  implicit none

  interface norm
    module procedure &
      norm_r8, &
      norm_r,  &
      norm_i,  &
      norm_c
  end interface

contains

  subroutine norm_r8(arg)
    implicit none
    real(kind=kind(1d0)), intent(in) :: arg

    write (*,*) "real8: ", arg
  end subroutine

  subroutine norm_r(arg)
    implicit none
    real, intent(in) :: arg

    write (*,*) "real: ", arg
  end subroutine

  subroutine norm_i(arg)
    implicit none
    integer, intent(in) :: arg

    write (*,*) "integer: ", arg
  end subroutine

  subroutine norm_c(arg)
    implicit none
    complex, intent(in) :: arg

    write (*,*) "complex: ", arg
  end subroutine

  subroutine get_proc_ptr(pp, arg)
    implicit none
    procedure(), pointer, intent(out) :: pp
    class(*), intent(inout) :: arg

    select type(arg)
      type is (real(kind=kind(1d0)))
         pp => norm_r8
      type is (real)
         pp => norm_r
      type is (integer)
         pp => norm_i
      type is (complex)
         pp => norm_c
      class default
         pp => null()
    end select
  end subroutine

end module

program test
  use proc
  implicit none
  real(kind=kind(1d0)) :: arg_r8
  real                 :: arg_r
  integer              :: arg_i
  complex              :: arg_c
  procedure(), pointer :: pNorm => null()

  arg_r8 = 4.0123456789d30
  arg_r = 12.5
  arg_i = 56
  arg_c = (34,3)

  call get_proc_ptr(pNorm, arg_r8)
  call pNorm(arg_r8)

  call get_proc_ptr(pNorm, arg_r)
  call pNorm(arg_r)

  call get_proc_ptr(pNorm, arg_i)
  call pNorm(arg_i)

  call get_proc_ptr(pNorm, arg_c)
  call pNorm(arg_c)

end program

And here is the output of this program:

$ ./testprocptr 
 real8:    4.0123456788999999E+030
 real:    12.5000000    
 integer:           56
 complex:  (  34.0000000    ,  3.00000000    )