Problem with interfaces and procedure pointers in F03/08

See the attached MWE, which I believe is legal Fortran. I am trying to combine procedure pointers with an abstract interface. The desired effect would be for a single routine that makes use of an interface calling the correct procedure pointer depending on how these are initalized. The code compiles and runs correctly with gfortran and ifort, but doesn’t compile with nvhpc 21.7 → 23.3

module test1
  implicit none
contains

  subroutine f11(s_out, s_in)
    implicit none
    integer :: s_out, s_in
    write (*,*) "Hello world from test1: f11"
  end subroutine f11

  subroutine f12(s_out, s_in)
    implicit none
    real :: s_out, s_in
    write (*,*) "Hello world from test1: f12"
  end subroutine f12

end module test1

module test2
  implicit none
contains

  subroutine f21(s_out, s_in)
    implicit none
    integer :: s_out, s_in
    write (*,*) "Hello world from test2: f21"
  end subroutine f21

  subroutine f22(s_out, s_in)
    implicit none
    real :: s_out, s_in
    write (*,*) "Hello world from test2: f22"
  end subroutine f22

end module test2

module test_generic_mod
  use test1
  use test2
  private

  public choose_sub
  public hello
  
  procedure(f1), pointer :: rout1
  procedure(f2), pointer :: rout2
  
  interface hello
     procedure &
          rout1, &
          rout2 
  end interface hello

  abstract interface
     subroutine f1(s_out, s_in)
       implicit none
       integer :: s_out, s_in
     end subroutine f1
  end interface

  abstract interface
     subroutine f2(s_out, s_in)
       implicit none
       real :: s_out, s_in
     end subroutine f2
  end interface

contains

  subroutine choose_sub(iopt)
    implicit none
    integer :: iopt

    if ( iopt == 1 ) then
       rout1 => f11
       rout2 => f12
    else
       rout1 => f21
       rout2 => f22
    end if
  end subroutine choose_sub
end module test_generic_mod

program test_hello
  use test_generic_mod
  implicit none
  integer :: iopt
  integer :: i,j
  real    :: r,s

  write (*,*) "Test first set of routines:"
  iopt = 1
  call choose_sub(iopt)
  call hello(i,j)
  call hello(r,s)

  write (*,*)
  write (*,*) "Test second set of routines:"
  iopt = 2
  call choose_sub(iopt)
  call hello(i,j)
  call hello(r,s)
  
end program test_hello

Hi Fedeh,

I talked with engineering. New features such as this are being implemented in the F18 flang compiler which we’re collaborating on with the LLVM community. This version of flang will eventually replace nvfortran. Since your code compiles with flang, we’re not sure we’ll implement this in nvfortran. Though, I added an request, TPR #34782, and we’ll see what we can do.

They also provided a work around code which may be helpful:

module test1
  implicit none
contains
  subroutine f11(s_out, s_in)
    implicit none
    integer :: s_out, s_in
    write (*,*) "Hello world from test1: f11"
  end subroutine f11
  subroutine f12(s_out, s_in)
    implicit none
    real :: s_out, s_in
    write (*,*) "Hello world from test1: f12"
  end subroutine f12
end module test1
module test2
  implicit none
contains
  subroutine f21(s_out, s_in)
    implicit none
    integer :: s_out, s_in
    write (*,*) "Hello world from test2: f21"
  end subroutine f21
  subroutine f22(s_out, s_in)
    implicit none
    real :: s_out, s_in
    write (*,*) "Hello world from test2: f22"
  end subroutine f22
end module test2
module test_generic_mod
  use test1
  use test2
  private
  public choose_sub
  public hello
  procedure(f1), pointer :: rout1
  procedure(f2), pointer :: rout2
  interface hello
     procedure &
          rout1_wrapper, &
          rout2_wrapper
  end interface hello
  abstract interface
     subroutine f1(s_out, s_in)
       implicit none
       integer :: s_out, s_in
     end subroutine f1
  end interface
  abstract interface
     subroutine f2(s_out, s_in)
       implicit none
       real :: s_out, s_in
     end subroutine f2
  end interface
contains
  subroutine rout1_wrapper(s_out, s_in)
       implicit none
       integer :: s_out, s_in
       call rout1(s_out, s_in)
  end subroutine
  subroutine rout2_wrapper(s_out, s_in)
       implicit none
       real :: s_out, s_in
       call rout2(s_out, s_in)
  end subroutine
  subroutine choose_sub(iopt)
    implicit none
    integer :: iopt
    if ( iopt == 1 ) then
       rout1 => f11
       rout2 => f12
    else
       rout1 => f21
       rout2 => f22
    end if
  end subroutine choose_sub
end module test_generic_mod
program test_hello
  use test_generic_mod
  implicit none
  integer :: iopt
  integer :: i,j
  real    :: r,s
  write (*,*) "Test first set of routines:"
  iopt = 1
  call choose_sub(iopt)
  call hello(i,j)
  call hello(r,s)
  write (*,*)
  write (*,*) "Test second set of routines:"
  iopt = 2
  call choose_sub(iopt)
  call hello(i,j)
  call hello(r,s)
end program test_hello

-Mat

Hi Matt,
Thank you for the prompt response and for the code. We came up with a workaround as well, and glad to hear this feature will make it into future nvhpc versions.
-Federico

This topic was automatically closed 14 days after the last reply. New replies are no longer allowed.