Passing a subroutine as an argument to another sub

Help
1

Hello,

I want to pass different subroutines/functions to a finite different subroutine for computation, without doing the FD implementation for every possible function again.

Basically one module stores plenty of functions, which can also be composed for more complex behavior. The programmer then picks what he needs from this module and uses it in main_function.
Then, the derivative has to be computed with finite differences. Therefore, it makes sense to me to have one routine doing the FD scheme and only passing the function to it that is needed, so I do not need to implement the FD method for each possible function that comes up.

The main_function is called by the main programm and is stored in a separate shared library. I tried to do the following:

subroutine main_function(arg1, arg2, arg3)

use module1, only: sub
use fd_module

implicit none

real*8 :: arg1, arg2, arg3

! Do stuff

call fd_sub(arg1, arg2, sub)

return

The way the main_function is called is fixed in the main program. Module1 will contain several similar routines to sub, all taking the same imput and producing the same output. (In this case, taking strain and parameters in and return mechanical stress)

The sub is defined in its module like

module module1

implicit none
contains

subroutine sub1(a1, a2, a3)
real*8 :: a1, a2, a3
! do stuff
end subroutine sub1
end module

The next part is where I will get a segmentation fault in run-time, which lets me assume something is wrong with how I actually call the subroutine:


module fd_module

implicit none

interface
   subroutine sub_interface(a1, a2, a3)
   real*8 a1, a2, a3
   end subroutine sub_interface
end interface

contains

subroutine fd_sub(a1, a2, a3, sub)

real*8 a1, a2, a3
real*8 b1, b2

procedure(sub_interface), pointer :: sub

! Do stuff, obtain more values bi
! ...

call sub(b1, b2)

end subroutine

The compiler (gfortran) has nothing to complain, on runtime the program comes to a halt at call sub(b1, b2, sub) and exits shortly after with a segmentation fault.

I am relatively new to fortran, coming from years of Julia and Python, so that pointer/interface thing does leave me confused.

Thanks for any advice.

2

Welcome to the forum. The somewhat surprising thing is that you call subroutine sub with an argument sub - so instead of a real you are actually passing the address of the subroutine. But that is something the compiler should have warned about - the types do not match.

Is this the actual, beit abbreviated, code? In this sort of cases, the devil is often in the details. Could you provide a compileable example? A runtime error is a bonus ;).

3

Sorry, I messed up a bit. That line only should contain

call sub(b1, b2)

as the subroutine (pointer?) is passed to the fd_sub. I edited my original post.

Yes, the code is highly abbreviated. The live-problem does contain by far more lines. I will try to extract a minimal working example, hopefully including the segmentation fault.

4

Hi.
Some suggestions that come to mind:

  • You can make the interface abstract, to let the compiler know that there’s not an actual subroutine with the name sub_interface.
  • You could also drop the pointer attribute —unless you intend to make it point to some other subroutine.
  • Your code is invoking the passed procedure with two arguments, but the interface declares three. If the third argument is optional, make it so explicitly.

Which version of gfortran are you using?

5

Shame on me, thats a typo as well. I did rush cutting things of from my code too quickly.
However, I hacked together a minimal example that is actually working, without any dumps.
Unfortunately, I can’t upload anything, I will just post the file contents then.

The code below produces the result i want. If I remove sub_ptr => sub1 etc., I will end up with a segmentation fault as well. I think I figured whats going on now, and will look for it in my original code.

Main program:

program Main

    use routines
    use fd_driver
    implicit none

    real*8 :: a, b

    procedure(sub_interface), pointer :: sub_ptr

    write(*,*) 'Hello, world!'
    
    a = 1.d0
    b = 2.d0  
    sub_ptr => sub1
    call fd_sub(a, b, sub_ptr)
    write(*,*) 'a = ', a, ' b = ', b

    a = 1.d0
    b = 2.d0  
    sub_ptr => sub2
    call fd_sub(a, b, sub_ptr)
    write(*,*) 'a = ', a, ' b = ', b

! Do stuff here
end program

Subroutine database:

module routines

implicit none

contains

subroutine sub1(a, b)
    implicit none
    real*8, intent(in)  :: a
    real*8, intent(out) :: b
    write(*,*) 'call sub1'
    b = 10*a
end subroutine sub1

subroutine sub2(a, b)
    implicit none
    real*8, intent(in)  :: a
    real*8, intent(out) :: b
    write(*,*) 'call sub2'
    b = 100*a
end subroutine sub2

end module routines

fd_driver module: (That takes subroutines as an argument)

module fd_driver

    interface 
    subroutine sub_interface(a, b)
        implicit none
        real*8, intent(in) :: a
        real*8, intent(out) :: b

    end subroutine sub_interface
    end interface

contains


subroutine fd_sub(c, d, sub)

    implicit none
    real*8 :: c, d
    procedure(sub_interface), pointer :: sub

    write(*,*) 'This is the fd subroutine'
    call sub(c, d)

end subroutine fd_sub

end module

For completness, the Makefile content as well:

FC = gfortran
FFLAGS = -O2 -Wall -Wextra
EXEC = my_program
SRCS = $(wildcard *.f90)

OBJS = $(SRCS:.f90=.o)
MAIN_OBJ = main.o
OTHER_OBJS = $(filter-out $(MAIN_OBJ), $(OBJS))

all: $(EXEC)

$(EXEC): $(OBJS)
	$(FC) $(FFLAGS) -o $@ $^

$(MAIN_OBJ): $(OTHER_OBJS)

%.o: %.f90
	$(FC) $(FFLAGS) -c $< -o $@

clean:
	rm -f $(OBJS) $(EXEC)

.PHONY: all clean
6

Here is an example using abstract interface, from Grok 3. Compiling and running

! Module containing the subroutine definitions
module arithmetic_operations
    implicit none

contains

    subroutine add_numbers(x, y)
        real, intent(in) :: x, y
        real :: sum    
        sum = x + y
        print *, "Inside add_numbers: Sum of ", x, " and ", y, " is ", sum
    end subroutine add_numbers

    subroutine multiply_numbers(x, y)
        real, intent(in) :: x, y
        real :: product       
        product = x * y
        print *, "Inside multiply_numbers: Product of ", x, " and ", y, " is ", product
    end subroutine multiply_numbers

end module arithmetic_operations

! Module containing the procedure interface and caller
module my_procedures
    implicit none
    
    ! Define an abstract interface for the subroutine with two real arguments
    abstract interface
        subroutine sub_interface(x, y)
            real, intent(in) :: x, y
        end subroutine sub_interface
    end interface

contains

    ! The subroutine that will receive another subroutine as an argument
    subroutine caller(proc, a, b)
        procedure(sub_interface) :: proc  ! Procedure argument
        real, intent(in) :: a, b
        ! Call the passed subroutine with arguments a and b
        print *, "Inside caller: Calling the passed subroutine"
        call proc(a, b)
    end subroutine caller

end module my_procedures

program test_procedure_passing
    use my_procedures        ! Use the module with caller
    use arithmetic_operations ! Use the module with add_numbers and multiply_numbers
    implicit none    
    real :: val1, val2
    ! Set some test values
    val1 = 3.5
    val2 = 2.0    
    print *, "Testing with add_numbers:"
    call caller(add_numbers, val1, val2)
    print *, "Testing with multiply_numbers:"
    call caller(multiply_numbers, val1, val2)
end program test_procedure_passing

gives

 Testing with add_numbers:
 Inside caller: Calling the passed subroutine
 Inside add_numbers: Sum of    3.50000000      and    2.00000000      is    5.50000000    
 Testing with multiply_numbers:
 Inside caller: Calling the passed subroutine
 Inside multiply_numbers: Product of    3.50000000      and    2.00000000      is    7.00000000
1 Like
7

Simplest way is to avoid procedure pointers, and just specify the interface in your fd_sub procedure:

module fd_driver

contains

subroutine fd_sub(c, d, sub)

    implicit none
    real*8 :: c, d

    interface
      subroutine sub (x, y)
        implicit none
        real*8, intent(in) :: x
        real*8, intent(out) :: y
      end subroutine
    end interface

    write(*,*) 'This is the fd subroutine'
    call sub(c, d)

end subroutine fd_sub

end module

Then your main program would look like:

program Main

    use routines
    use fd_driver
    implicit none

    real*8 :: a, b

    write(*,*) 'Hello, world!'
    
    a = 1.d0
    b = 2.d0  
    call fd_sub(a, b, sub1)
    write(*,*) 'a = ', a, ' b = ', b

    a = 1.d0
    b = 2.d0  
    call fd_sub(a, b, sub2)
    write(*,*) 'a = ', a, ' b = ', b

! Do stuff here
end program
8

Thanks, I think I found the error now. Somehow, I was passing in a pointer to the caller from the main routine:

program test_procedure_passing
    use my_procedures        ! Use the module with caller
    use arithmetic_operations ! Use the module with add_numbers and multiply_numbers
    implicit none    
    real :: val1, val2
    procedure(add_numbers), pointer :: add_ptr
    ! Set some test values
    val1 = 3.5
    val2 = 2.0    
    print *, "Testing with add_numbers:"
    call caller(add_numbers, val1, val2)
    print *, "Testing with multiply_numbers:"
    call caller(add_ptr, val1, val2)
end program test_procedure_passing

This will end up in a segmentation fault.

9

What I meant to say previously by not needing the pointer attribute, is that it’s only required if you want to point somewhere. Otherwise, it’s redundant, as in the following snippet from your example:

Also, if you add the -std=f2018 compiler flag, you’re in for some fun —particularly, the real*8 portion is not standard, and you should use real(8) or (better!) real(real64) instead (with real64 coming from the iso_fortran_env module).

10

Yes, because the add_ptr procedure pointer is not pointing anywhere :slight_smile: .