To host functions within a threaded subroutine

Question

I encountered a problem when I port my Fortran project to OpenMP. In my original code, there are two functions named add and mpy being passed to a threaded subroutine submodel that throws respective function into another subroutine defined in a module toolbox.

Now, for my new code, I am wondering whether there is a way to produce exactly the same outcome as with my original code but with a tiny twist that moves the two functions add and mpy to be hosted (i.e., contained) within the subroutine submodel.

Thanks.

Lee

--- My original code consists of four files: MAIN.F90, MODEL.F90, VARIABLE.F90, and TOOLBOX.F90

OUTPUT:

--- addition ---
    3    7   11   15
--- multiplication ---
    2   12   30   56
Press any key to continue . . .

MAIN.F90

program main
    use model
    implicit none  
    call sandbox()
end program main

MODEL.F90

module model
    use omp_lib
    use variable
    implicit none
contains
    subroutine submodel(func,x,y)
        implicit none
        interface
            function func(z)
                implicit none
                integer :: z,func
            end function func
        end interface
        integer :: x,y
        call tool(func,x,y)
    end subroutine submodel

    function add(a)
        implicit none
        integer :: a,add
        add=a+thread_private
    end function add 

    function mpy(m)
        implicit none
        integer :: m,mpy
        mpy=m*thread_private
    end function mpy

    subroutine sandbox()
        implicit none
        integer :: a(4),b(4),c(4),i
        a=[((i),i=1,7,2)]
        b=[((i),i=2,8,2)]
        !$omp parallel do
        do i=1,4
            thread_private=b(i)
            call submodel(add,a(i),c(i))    
        enddo
        !$omp end parallel do
        write(6,'(a)') '--- addition ---'
        write(6,'(4(i5))') c

        !$omp parallel do
        do i=1,4
            thread_private=b(i)
            call submodel(mpy,a(i),c(i))
        enddo
        !$omp end parallel do
        write(6,'(a)') '--- multiplication ---'
        write(6,'(4(i5))') c  
    end subroutine sandbox
end module model

TOOLBOX.F90

module toolbox
    implicit none
contains
    subroutine tool(funct,input,output)
        implicit none
        interface
           function funct(x)
                implicit none
                integer :: x,funct
            end function funct
        end interface
        integer :: input,output
        output = funct(input)
    end subroutine tool
end module toolbox

VARIABLE.F90

module variable
    use toolbox
    implicit none
    integer :: thread_private
    !$omp threadprivate(thread_private)
end module variable

Is it possible to simply rearrange them in this way? (I have tried and apparently it failed):

subroutine submodel(func,x,y)
    implicit none
    interface
        function func(z)
            implicit none
            integer :: z,func
        end function func
    end interface
    integer :: x,y
    call tool(func,x,y)
contains
    function add(a)
        implicit none
        integer :: a,add
        add=a+thread_private
    end function add 

    function mpy(m)
        implicit none
        integer :: m,mpy
        mpy=m*thread_private
    end function mpy
end subroutine submodel

Answer 1

You can make the two procedures internal to the subroutine submodel exactly as you did in your last code snippet. The problem is you cannot pass these two subroutines as actual arguments from outside of the subroutine, because you have no access to them there.

Even if you have procedure pointers to them stored somewhere, these would be invalid as soon as the original run of submodel that could have created them ended.

I would think about using some switch:

subroutine submodel(switch,x,y)
    implicit none
    integer :: switch,x,y

    select case(switch)
      case(USE_ADD)
        call tool(add,x,y)
      case(USE_MPY)
        call tool(mpy,x,y)
      case default
        stop "unknown switch value"
    end select
contains
    function add(a)
        implicit none
        integer :: a,add
        add=a+thread_private
    end function add 

    function mpy(m)
        implicit none
        integer :: m,mpy
        mpy=m*thread_private
    end function mpy
end subroutine submodel

Another option is to keep your original design.