Interfaces for passing subroutines to subroutines

Help
7

I’ve tried making a minimal working example for the abstract interface of @jwmwalrus below. Does it possibly work for the purpose…?

!! def.f90
module Definitions
  implicit none
  INTEGER, PARAMETER :: num = KIND(0.d0)
  INTEGER, PARAMETER :: HEADER_LENGTH = 1024
  REAL(num), PARAMETER :: PI = 4.0_num*ATAN(1.0_num)

  abstract interface
    subroutine f_i (someVar)
      IMPORT :: num   !!<--- this can be just "import" (then import everything outside)
      REAL(num) :: someVar
    end
    subroutine g_i (someVar,someInt,f)
      IMPORT :: num, f_i
      REAL(num) :: someVar
      INTEGER :: someInt
      procedure(f_i) :: f
    end
    subroutine h_i (someVar,anotherVar,someInt,f,g)
      IMPORT :: num, f_i, g_i
      REAL(num) :: someVar, anotherVar
      INTEGER :: someInt
      procedure(f_i) :: f
      procedure(g_i) :: g
    end
  end interface

end module Definitions

!! func.f90
module Functions

  USE Definitions, only: num, f_i, g_i, h_i
  implicit none

contains

  subroutine f1 (someVar)
    REAL(num) :: someVar
    !!
    print *, ">> f1"
    someVar = 2.0
  end
  subroutine f2 (someVar)
    REAL(num) :: someVar
    !!
    print *, ">> f2"
    someVar = 2.0*sin(1.0)
    print *, "        2 * sin(1.0) = ", someVar
  end

  subroutine g1 (someVar,someInt,f)
    REAL(num) :: someVar
    INTEGER :: someInt
    procedure(f_i) :: f
    !!
    print *, ">> g1"
    call f(someVar)
    someInt = 2
  end
  subroutine g2 (someVar,someInt,f)
    REAL(num) :: someVar
    INTEGER :: someInt
    procedure(f_i) :: f
    !!
    print *, ">> g2"
    someVar = cos(2.0)
    someInt = 3
  end
  subroutine h1 (someVar,anotherVar,someInt,f,g)
    REAL(num) :: someVar, anotherVar
    INTEGER :: someInt
    procedure(f_i) :: f
    procedure(g_i) :: g
    !!
    print *, ">> h1"
    call g(someVar,someInt,f)
    anotherVar = 3.0
  end
  subroutine h2 (someVar,anotherVar,someInt,f,g)
    REAL(num) :: someVar, anotherVar
    INTEGER :: someInt
    procedure(f_i) :: f
    procedure(g_i) :: g
    !!
    print *, ">> h2"
    call f(someVar)
    someInt = -1
    anotherVar = 5.0
  end

end module Functions

!! main.f90
program testing_interfaces

  use Definitions, only: num, f_i, g_i, h_i
  use Functions,   only: f1, f2, g1, g2, h1, h2
  implicit none

  procedure (f_i), pointer :: f_ptr => null ()
  procedure (g_i), pointer :: g_ptr => null ()
  procedure (h_i), pointer :: h_ptr => null ()

  INTEGER :: num_args, var1
  REAL(num) :: var2, var3
  num_args = iargc()

  print *, "num_args = ", num_args

  if (num_args <= 0) then
    f_ptr => f1
    g_ptr => g1
    h_ptr => h1
  else
    f_ptr => f2
    g_ptr => g2
    h_ptr => h2
  end if

  call h_ptr(var2,var3,var1,f_ptr,g_ptr)

  print*, var1, var2, var3

end program testing_interfaces

Test

$ gfortran def.f90 func.f90 main.f90
$ ./a.out
 num_args =            0
 >> h1
 >> g1
 >> f1
           2   2.0000000000000000        3.0000000000000000
$ ./a.out arg1
 num_args =            1
 >> h2
 >> f2
         2 * sin(1.0) =    1.6829419136047363     
          -1   1.6829419136047363        5.0000000000000000

(Here, I’ve inserted print statements for the subroutine name, so that which subroutine is called specifically.)

1 Like