Search code examples
classoopfortrangfortransubroutine

Passing subroutine names from external classes in Fortran


In How to pass subroutine names as arguments in Fortran classes? we learned how to pass subroutine names as arguments INSIDE Fortran classes. But how do we pass subroutine names from an OUTSIDE class?

The ensuing code produces compilation errors for two distinct attempts using GNU Fortran (GCC) 5.1.0:

gfortran  -Wall -Wextra -Wconversion -Og -pedantic -fcheck=bounds -fmax-errors=5 casey.f08 
casey.f08:42:37:

         call selector ( ints % square, x , y )
                                     1
Error: Expected argument list at (1)
casey.f08:43:24:

         call selector ( ints % double ( x, y ), x , y )
                        1
Error: ‘double’ at (1) should be a FUNCTION

The goal is for the routine selector to employ different computational paths: one to square a number, another to double it. The first compilation error suggests adding an argument list. The naive remedy for this produces the second error.

An MWE follows. Programming by permutation has produced many variants; hopefully this version can be remedied easily.

module myModule

    implicit none

    type     :: intermediates
        real :: z
    contains
        private
        procedure, nopass, public :: square => square_sub
        procedure, nopass, public :: double => double_sub
    end type intermediates

    private :: square_sub
    private :: double_sub

contains

    subroutine square_sub ( x, y )
        real, intent ( in )  :: x
        real, intent ( out ) :: y
            y = x ** 2
    end subroutine square_sub

    subroutine double_sub ( x, y )
        real, intent ( in )  :: x
        real, intent ( out ) :: y
            y = x * 2
    end subroutine double_sub

end module myModule


program casey

    use myModule
    implicit none

    real :: x = 10.0, y
    type ( intermediates ) :: ints
        call selector ( ints % square, x , y )
        call selector ( ints % double ( x, y ), x , y )

contains

    subroutine selector ( sub, x, y )

        interface mySub
            subroutine sub ( x, y )
                real, intent ( in )  :: x
                real, intent ( out ) :: y
            end subroutine sub
        end interface mySub

        real, intent ( in )  :: x
        real, intent ( out ) :: y

            call sub ( x, y )
            print *, 'x = ', x, ', y = ', y

    end subroutine selector

end program casey

Solution

  • The solution is to place the selector procedure inside the class. In the example above, subroutine selector is inside the program. Below subroutine local_selector is a procedure within the type mySubs.

    module mySubs
    
        implicit none
    
        type :: myClass
        contains
            procedure, nopass, public :: square
            procedure, nopass, public :: double
            procedure, nopass, public :: local_selector
        end type myClass
    
    contains
    
        subroutine square ( x, y )
            real, intent ( in )  :: x
            real, intent ( out ) :: y
                y = x ** 2
                print *, 'x = ', x, '; x ** 2 = ', y
        end subroutine square
    
        subroutine double ( x, y )
            real, intent ( in )  :: x
            real, intent ( out ) :: y
                y = x * 2
                print *, 'x = ', x, '; 2 x = ', y
        end subroutine double
    
        subroutine local_selector ( sub, x, y )
    
            interface mySub
                subroutine sub ( x, y )
                    real, intent ( in )  :: x
                    real, intent ( out ) :: y
                end subroutine sub
            end interface mySub
    
            real, intent ( in )  :: x
            real, intent ( out ) :: y
    
                call sub ( x, y )
    
        end subroutine local_selector
    
    end module mySubs
    
    program fixed
    
        use mySubs
        implicit none
    
        real :: x = 10.0, y
    
        type ( myClass ) :: thisClass
    
            call thisClass % local_selector ( square, x , y )
            call thisClass % local_selector ( double, x , y )
    
    end program fixed