Setting procedure pointers in a DLL

Jacob_Williams · ‎11-10-2017

Fortran gurus,

I was wondering if there was an easy way for a main program to associate procedure pointers that are present in a dynamically-loaded DLL. So, for example, say the DLL contained the following module:

module dll_module

    abstract interface
        subroutine blah_( a,b,c )
        integer  :: a,b,c
        end subroutine blah_
    end interface

    procedure(blah_),pointer,public,protected :: blah => null()

end module dll_module

This DLL is loaded using LoadLibrary() by the main program (which is also Fortran). What I want is for the main program to then associate "blah" to a function present in the main program that the DLL would then have access to.

Now, I have a way to do this that involves adding a setter function to the DLL like so:

subroutine set_blah_pointer(p)
!DEC$ ATTRIBUTES DEFAULT, DLLEXPORT, ALIAS:"set_blah_pointer" :: set_blah_pointer
type(c_funptr), intent(in) :: p
procedure(blah_),pointer :: fp
call c_f_procpointer(p, fp)
blah => fp
end subroutine set_blah_pointer

The main program then calls this setter, passing in the c_funloc of the function, which then gets associated. This does work, but my question is, is there way to do this that is "cleaner" on the DLL side? (that doesn't involve adding this extra function for each of the pointers). If I could DLLEXPORT the procedure pointer, then how would I access it in the main program?

Jacob

Steve_Lionel · ‎11-10-2017

You would put the procedure pointer in a module that is built as part of the DLL project. Then USE that module in the main program. For example:

module dll_mod
procedure(), pointer :: dll_proc_ptr
!DEC$ ATTRIBUTES DLLEXPORT :: dll_proc_ptr
end module dll_mod

Jacob_Williams · ‎11-10-2017

Is it possible to USE a module from a DLL that is loaded at runtime via LoadLibrary? In my case, the DLLs (there could be many of them) optionally contain this module to allow them to call some functions in the main program. The idea being that the DLLs are created by users of the tool, but who don't otherwise have access to the sourcecode.

JVanB · ‎11-10-2017

I see two possible solutions. If you want to retain the PROTECTED attribute for the procedure pointers, you are really promising that you won't point them at anything except via a procedure defined within the module that defines the procedure pointers. But we could write a single subroutine that does all the pointing, relying on OPTIONAL arguments to figure out which ones to point at. I wish it were possible to make the first argument to a procedure of a PRIVATE type and OPTIONAL to force keywords for all actual arguments, but this seems to be not allowed in Fortran. Anyhow, here is pointdll1.f90

! pointdll1.f90
module M
   implicit none
   private
   public sub_,blah_,blalalala_,set_pointers,callme
   abstract interface
      subroutine sub_(x)
         implicit none
         integer x
      end subroutine sub_
      subroutine blah_(x)
         implicit none
         real x
      end subroutine blah_
      subroutine blalalala_(x)
         implicit none
         character(*) x
      end subroutine blalalala_
   end  interface
   procedure(sub_),pointer,public,protected :: sub => null()
   procedure(blah_),pointer,public,protected :: blah => null()
   procedure(blalalala_),pointer,public,protected :: blalalala => null()
   contains
      subroutine set_pointers(point_at_sub,point_at_blah,point_at_blalalala)
!DEC$ ATTRIBUTES DLLEXPORT :: set_pointers
         procedure(sub_),optional :: point_at_sub
         procedure(blah_),optional :: point_at_blah
         procedure(blalalala_),optional :: point_at_blalalala
         if(present(point_at_sub)) then
            sub => point_at_sub
         end if
         if(present(point_at_blah)) then
            blah => point_at_blah
         end if
         if(present(point_at_blalalala)) then
            blalalala => point_at_blalalala
         end if
      end subroutine set_pointers
      subroutine callme()
!DEC$ ATTRIBUTES DLLEXPORT :: callme
         if(associated(sub)) then
            call sub(1)
         end if
         if(associated(blah)) then
            call blah(1.0)
         end if
         if(associated(blalalala)) then
            call blalalala('hana')
         end if
      end subroutine callme
end module M

And main1.f90

! main1.f90
module N
   implicit none
   contains
      subroutine mysub(x)
         integer x
         write(*,'(*(g0))') 'Greetings from mysub. x = ',x
      end subroutine mysub
      subroutine myblalalala(x)
         character(*) x
         write(*,'(*(g0))') 'Greetings from myblalalala. x = ',x
      end subroutine myblalalala
end module N

program P
   use M
   use N
   implicit none
   call set_pointers(point_at_sub = mysub, point_at_blalalala = myblalalala)
   call callme
end program P

Build instructions for main1.exe:

rem makedll1.bat
ifort /dll pointdll1.f90
ifort main1.f90 pointdll1.lib

Output of main1.exe:

reetings from mysub. x = 1
reetings from myblalalala. x = hana

You can always cheat your way around a restriction like this but is you are going to do it anyway, why make them PROTECTED in the first place? Get rid of that and you can just point in your main program. I see that while I was composing these examples Steve suggested this approach. Here is pointdll2.f90:

! pointdll2.f90
module M
   implicit none
   private
   public sub_,blah_,blalalala_,callme
   abstract interface
      subroutine sub_(x)
         implicit none
         integer x
      end subroutine sub_
      subroutine blah_(x)
         implicit none
         real x
      end subroutine blah_
      subroutine blalalala_(x)
         implicit none
         character(*) x
      end subroutine blalalala_
   end  interface
!DEC$ ATTRIBUTES DLLEXPORT :: sub, blah, blalalala
   procedure(sub_),pointer,public :: sub => null()
   procedure(blah_),pointer,public :: blah => null()
   procedure(blalalala_),pointer,public :: blalalala => null()
   contains
      subroutine callme()
!DEC$ ATTRIBUTES DLLEXPORT :: callme
         if(associated(sub)) then
            call sub(1)
         end if
         if(associated(blah)) then
            call blah(1.0)
         end if
         if(associated(blalalala)) then
            call blalalala('hana')
         end if
      end subroutine callme
end module M

And main2.f90:

! main2.f90
module N
   implicit none
   contains
      subroutine mysub(x)
         integer x
         write(*,'(*(g0))') 'Greetings from mysub. x = ',x
      end subroutine mysub
      subroutine myblalalala(x)
         character(*) x
         write(*,'(*(g0))') 'Greetings from myblalalala. x = ',x
      end subroutine myblalalala
end module N

program P
   use M
   use N
   implicit none
   sub => mysub
   blalalala => myblalalala
   call callme
end program P

Build instructions for main2.exe:

rem makedll2.bat
ifort /dll pointdll2.f90
ifort main2.f90 pointdll2.lib

Output of main2.exe:

Greetings from mysub. x = 1
Greetings from myblalalala. x = hana

Jacob_Williams · ‎11-10-2017

See my response to Steve above. In my case, the 2nd solution won't work because the main program doesn't have access to module M at compile time (keeping in mind that there can be more than one DLL, each with its own module M). If I export sub, blah, blalalala from the DLL, then how do I access them in the main program at runtime?

Steve_Lionel · ‎11-10-2017

I forgot you said you were using LoadLibrary. There are solutions to this but, to be honest, the "setter" procedure is probably the best option.

IanH · ‎11-10-2017

You use GetProcAddress to query the address of something in a DLL, even if that something isn't a "Proc".

But I very much agree with Steve in #6.

! Compile to a DLL
MODULE m20171111
  USE, INTRINSIC :: ISO_C_BINDING
  IMPLICIT NONE
  TYPE(C_FUNPTR), BIND(C, NAME='proc_ptr') :: proc_ptr
  !DEC$ ATTRIBUTES DLLEXPORT :: proc_ptr
CONTAINS
  SUBROUTINE test() BIND(C, NAME='test')
    !DEC$ ATTRIBUTES DLLEXPORT :: test
    ABSTRACT INTERFACE
      SUBROUTINE s() BIND(C)
        IMPLICIT NONE
      END SUBROUTINE s
    END INTERFACE
    PROCEDURE(s), POINTER :: p
    
    CALL C_F_PROCPOINTER(proc_ptr, p)
    CALL p
  END SUBROUTINE test
END MODULE m20171111


! Compile to an exe
PROGRAM p20171111
  USE, INTRINSIC :: ISO_C_BINDING
  USE KERNEL32
  
  IMPLICIT NONE
  
  INTEGER(HANDLE) :: dll_handle
  
  TYPE(C_PTR) :: proc_ptr_cptr
  TYPE(C_FUNPTR), POINTER :: proc_ptr
  
  TYPE(C_FUNPTR) :: test_cptr
  ABSTRACT INTERFACE
    SUBROUTINE test_intf() BIND(C)
      IMPLICIT NONE
    END SUBROUTINE test_intf
  END INTERFACE
  PROCEDURE(test_intf), POINTER :: test
  
  dll_handle = LoadLibrary('m20171111.dll' // ACHAR(0))
  IF (dll_handle == 0) ERROR STOP 'dll_handle was zero'
  
  proc_ptr_cptr = TRANSFER(  &
      GetProcAddress(dll_handle, 'proc_ptr' // ACHAR(0)),  &
      proc_ptr_cptr )
  IF (.NOT. C_ASSOCIATED(proc_ptr_cptr))  &
      ERROR STOP 'proc_ptr_cptr not associated'
  CALL C_F_POINTER(proc_ptr_cptr, proc_ptr)
  
  proc_ptr = C_FUNLOC(my_s)
  
  test_cptr = TRANSFER(  &
      GetProcAddress(dll_handle, 'test' // ACHAR(0)),  &
      test_cptr )
  IF (.NOT. C_ASSOCIATED(test_cptr))  &
      ERROR STOP 'test_cptr not associated'
  CALL C_F_PROCPOINTER(test_cptr, test)
  CALL test()
CONTAINS
  SUBROUTINE my_s() BIND(C)
    PRINT "('Hello!')"
  END SUBROUTINE my_s
END PROGRAM p20171111

>ifort /check:all /warn:all /standard-semantics /dll m20171111.f90
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 18.0.0.124 Build 20170811
Copyright (C) 1985-2017 Intel Corporation.  All rights reserved.

Microsoft (R) Incremental Linker Version 14.00.24215.1
Copyright (C) Microsoft Corporation.  All rights reserved.

-out:m20171111.dll
-dll
-implib:m20171111.lib
m20171111.obj
   Creating library m20171111.lib and object m20171111.exp

>ifort /check:all /warn:all /standard-semantics p20171111.f90
Intel(R) Visual Fortran Intel(R) 64 Compiler for applications running on Intel(R) 64, Version 18.0.0.124 Build 20170811
Copyright (C) 1985-2017 Intel Corporation.  All rights reserved.

Microsoft (R) Incremental Linker Version 14.00.24215.1
Copyright (C) Microsoft Corporation.  All rights reserved.

-out:p20171111.exe
-subsystem:console
p20171111.obj

>p20171111
Hello!

JVanB · ‎11-10-2017

Whoa, Quote #3 happened while I was preparing Quote #4. You can USE such a module, but the data and procedures won't work, just stuff like type definitions, interfaces, and named constants. At least I think that you will need GetProcAddress and then C_F_PROCPOINTER to access procedures and C_F_POINTER to access data. OK, here is an example of this. Note that there is a problem that you can't USE the interface for subroutine callme directly here because the DLLEXPORT attribute in there just mungs up a procedure pointer that you try to point at it. I think that's a bug in ifort and maybe it's even fix in the latest version. Also there is the issue that procedure pointers aren't first-class objects in Fortran so you have to wrap them in a structure if you want to point at them. Here is pointdll3.f90:

! pointdll3.f90
module M
   implicit none
   private
   public sub_,blah_,blalalala_,callme
   abstract interface
      subroutine sub_(x)
         implicit none
         integer x
      end subroutine sub_
      subroutine blah_(x)
         implicit none
         real x
      end subroutine blah_
      subroutine blalalala_(x)
         implicit none
         character(*) x
      end subroutine blalalala_
   end  interface
   procedure(sub_),pointer,public :: sub => null()
!DEC$ ATTRIBUTES DLLEXPORT, ALIAS: 'sub' :: sub
   procedure(blah_),pointer,public :: blah => null()
!DEC$ ATTRIBUTES DLLEXPORT, ALIAS: 'blah' :: blah
   procedure(blalalala_),pointer,public :: blalalala => null()
!DEC$ ATTRIBUTES DLLEXPORT, ALIAS: 'blalalala' :: blalalala
   contains
      subroutine callme()
!DEC$ ATTRIBUTES DLLEXPORT, ALIAS: 'callme' :: callme
         if(associated(sub)) then
            call sub(1)
         end if
         if(associated(blah)) then
            call blah(1.0)
         end if
         if(associated(blalalala)) then
            call blalalala('hana')
         end if
      end subroutine callme
end module M

And main3.f90:

! main3.f90
module N
   use ISO_C_BINDING
   implicit none
   integer, parameter :: HANDLE = C_INTPTR_T
   integer, parameter :: DWORD = C_LONG
   interface
      function LoadLibrary(lpFileName) bind(C,name='LoadLibraryA')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: LoadLibrary
         integer(HANDLE) LoadLibrary
         character(KIND=C_CHAR) lpFileName(*)
      end function LoadLibrary
      function GetProcAddress(hModule,lpProcName) bind(C,name='GetProcAddress')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: GetProcAddress
         type(C_FUNPTR) GetProcAddress
         integer(HANDLE), value :: hModule
         character(KIND=C_CHAR) lpProcName(*)
      end function GetProcAddress
      function GetDataAddress(hModule,lpDataName) bind(C,name='GetProcAddress')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: GetDataAddress
         type(C_PTR) GetDataAddress
         integer(HANDLE), value :: hModule
         character(KIND=C_CHAR) lpDataName(*)
      end function GetDataAddress
      function GetLastError() bind(C,name='GetLastError')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: GetLastError
         integer(DWORD) GetLastError
      end function GetLastError
   end interface
   contains
      subroutine mysub(x)
         integer x
         write(*,'(*(g0))') 'Greetings from mysub. x = ',x
      end subroutine mysub
      subroutine myblalalala(x)
         character(*) x
         write(*,'(*(g0))') 'Greetings from myblalalala. x = ',x
      end subroutine myblalalala
end module N

program P
   use M, invalid => callme
   use N
   implicit none
   integer(HANDLE) hModule
   interface
      subroutine callme()
      end subroutine callme
   end interface
   procedure(callme), pointer :: pcallme
   type has_sub
      procedure(sub_), nopass, pointer :: sub
   end type has_sub
   type(has_sub), pointer :: subtype
   type has_blalalala
      procedure(blalalala_), nopass, pointer :: blalalala
   end type has_blalalala
   type(has_blalalala), pointer :: blalalalatype
   type(C_PTR) dptr
   type(C_FUNPTR) fptr
   hModule = LoadLibrary('pointdll3.dll'//achar(0))
   fptr = GetProcAddress(hModule,'callme'//achar(0))
   call C_F_PROCPOINTER(fptr,pcallme)
   dptr = GetDataAddress(hModule,'sub'//achar(0))
   call C_F_POINTER(dptr,subtype)
   subtype%sub => mysub
   dptr = GetDataAddress(hModule,'blalalala'//achar(0))
   call C_F_POINTER(dptr,blalalalatype)
   blalalalatype%blalalala => myblalalala
   call pcallme()
end program P

Build instructions for main3.exe:

rem makedll3.bat
ifort /dll pointdll3.f90
ifort main3.f90

Output of main3.exe:

Greetings from mysub. x = 1
Greetings from myblalalala. x = hana

JVanB · ‎11-10-2017

The pace of posts to this thread sees to be outstripping my own posting speed. But I think my example in Quote #8 is roughly what you are asking for. Do the module names actually conflict or are they different for the Fortran that compiles to each *.dll. If they conflict, you won't be able to use type definitions, interfaces and named constants from any of the modules, so you will have to rewrite them from scratch or via INCLUDE in programs that USE the modules. As it is ifort, through bugs in my opinion, forces you to rewrite the interface for any module procedures in the *.dll that you want to invoke directly from your main program.

IanH · ‎11-10-2017

Typically you would put the shared declarations of types and the like into a single,separate module, that was then used in program units that comprise the various DLLs and EXE.

JVanB · ‎11-10-2017

My sense of the use case is that the *.dll projects may come from sufficiently disparate groups that a single MODULE with everybody's declarations is not feasible. But is everyone names their module M instead of giving it a unique name, then that will be a problem. If everybody gives their module different names but uses the same names for entities within their modules, that's not a problem because Fortran can resolve these issues via the renaming clause of the USE statement. Giving procedures the same name is never a problem because GetProcAddress needed the handle to the appropriate *.dll to get a handle to the procedure anyway.

But it occurred to me that one could simplify the Fortran code if a *.def file were permitted in the build process. I showed in a post yesterday https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/748133#comment-1914738 how it might be possible to generate a *.def file automatically, although one slight modification would have to be made to the parser for this problem. But given a *.def file the Fortran code for the *.dll projects would not have to be marked up with all of those DLLEXPORT statements and the Fortran code for the main program would not have to rewrite the interface for procedures in the modules that it needs to invoke through a procedure pointer. Here's what I mean. pointdll4.f90:

! pointdll4.f90
module M
   implicit none
   private
   public sub_,blah_,blalalala_,callme
   abstract interface
      subroutine sub_(x)
         implicit none
         integer x
      end subroutine sub_
      subroutine blah_(x)
         implicit none
         real x
      end subroutine blah_
      subroutine blalalala_(x)
         implicit none
         character(*) x
      end subroutine blalalala_
   end  interface
   procedure(sub_),pointer,public :: sub => null()
   procedure(blah_),pointer,public :: blah => null()
   procedure(blalalala_),pointer,public :: blalalala => null()
   contains
      subroutine callme()
         if(associated(sub)) then
            call sub(1)
         end if
         if(associated(blah)) then
            call blah(1.0)
         end if
         if(associated(blalalala)) then
            call blalalala('hana')
         end if
      end subroutine callme
end module M

pointdll4.def:

; pointdll4.def
EXPORTS
      callme = M_mp_CALLME
      sub = M_mp_SUB               DATA
      blah = M_mp_BLAH             DATA
      blalalala = M_mp_BLALALALA   DATA

main4.f90:

! main4.f90
module N
   use ISO_C_BINDING
   implicit none
   integer, parameter :: HANDLE = C_INTPTR_T
   integer, parameter :: DWORD = C_LONG
   interface
      function LoadLibrary(lpFileName) bind(C,name='LoadLibraryA')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: LoadLibrary
         integer(HANDLE) LoadLibrary
         character(KIND=C_CHAR) lpFileName(*)
      end function LoadLibrary
      function GetProcAddress(hModule,lpProcName) bind(C,name='GetProcAddress')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: GetProcAddress
         type(C_FUNPTR) GetProcAddress
         integer(HANDLE), value :: hModule
         character(KIND=C_CHAR) lpProcName(*)
      end function GetProcAddress
      function GetDataAddress(hModule,lpDataName) bind(C,name='GetProcAddress')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: GetDataAddress
         type(C_PTR) GetDataAddress
         integer(HANDLE), value :: hModule
         character(KIND=C_CHAR) lpDataName(*)
      end function GetDataAddress
      function GetLastError() bind(C,name='GetLastError')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: GetLastError
         integer(DWORD) GetLastError
      end function GetLastError
   end interface
   contains
      subroutine mysub(x)
         integer x
         write(*,'(*(g0))') 'Greetings from mysub. x = ',x
      end subroutine mysub
      subroutine myblalalala(x)
         character(*) x
         write(*,'(*(g0))') 'Greetings from myblalalala. x = ',x
      end subroutine myblalalala
end module N

program P
   use M
   use N
   implicit none
   integer(HANDLE) hModule
   procedure(callme), pointer :: pcallme
   type has_sub
      procedure(sub_), nopass, pointer :: sub
   end type has_sub
   type(has_sub), pointer :: subtype
   type has_blalalala
      procedure(blalalala_), nopass, pointer :: blalalala
   end type has_blalalala
   type(has_blalalala), pointer :: blalalalatype
   type(C_PTR) dptr
   type(C_FUNPTR) fptr
   hModule = LoadLibrary('pointdll3.dll'//achar(0))
   fptr = GetProcAddress(hModule,'callme'//achar(0))
   call C_F_PROCPOINTER(fptr,pcallme)
   dptr = GetDataAddress(hModule,'sub'//achar(0))
   call C_F_POINTER(dptr,subtype)
   subtype%sub => mysub
   dptr = GetDataAddress(hModule,'blalalala'//achar(0))
   call C_F_POINTER(dptr,blalalalatype)
   blalalalatype%blalalala => myblalalala
   call pcallme()
end program P

Build instructions for main4.exe:

rem makedll4.bat
ifort /dll pointdll4.f90 pointdll4.def
ifort main4.f90

Output of main4.exe:

Greetings from mysub. x = 1
Greetings from myblalalala. x = hana

Sorry for the explosion of code, but I wanted to give complete examples of my ideas so they would be easier to understand.

FortranFan · ‎11-11-2017

Jacob Williams wrote:

Is it possible to USE a module from a DLL that is loaded at runtime via LoadLibrary? In my case, the DLLs (there could be many of them) optionally contain this module to allow them to call some functions in the main program. The idea being that the DLLs are created by users of the tool, but who don't otherwise have access to the sourcecode.

@Jacob Williams,

What exactly are you interested in? Is it really a call-back system, meaning you have a Fortran main program for which users introduce their own libraries (DLLs) with methods to be called by the main program but where the user code calls subprograms (procedures) that are part of the main program? Why not then simply pass the procedure pointers as part of the argument list itself for the DLL methods that are called by the main program, thus avoiding the extra setter methods? That seems a lot 'cleaner' than any of the alternatives.

That is, you can indeed do as shown upthread in Quotes 10 , 8, etc. (and a simpler version is shown below), but you will be violating the spirit of the PROTECTED attribute of your procedure pointer by setting their targets by means other than module procedures. It doesn't appear any 'cleaner' of an option then. Depending on how the main program is structured and what the user DLLs need to do, I might even consider object-oriented design of a wrapper 'class' i,.e., a derived type with type components are procedure pointers to methods in the main program and (some of) the bound procedures of said type are 'implemented' by users via DLLs; the main program only then deals with the wrapper 'class' and its methods but not the user methods directly and all the wiring is connected up in this 'class' by means of Fortran.

So a simpler variation of what was interpreted by Repeat Offender and IanH of your description in the original post might be the following, but note I won't recommend this:

User code:

module i

   abstract interface
      subroutine Isub( s )
         character(len=*), intent(in) :: s
      end subroutine
   end interface

end module

module m

   use i, only : Isub
   
   implicit none
   
   private

   procedure(Isub), pointer, save, public, protected :: psub => null()

contains

   subroutine foo()

      character(len=:), allocatable :: msg

      msg = "Hello World!"

      call psub( msg )
      
      return

   end subroutine

end module m

Module definition file for user DLL - by the way, I do strongly recommend such DEF files over DLLEXPORT directives which clutter Fortran code:

LIBRARY m
EXPORTS
   M_mp_PSUB        @1      DATA
   M_mp_FOO         @2

Main program - note the main program knows nothing about interfaces of stuff in user DLL since it does not 'USE' user MOD file as you indicated - this is not ideal:

module cb_m
! Call back module

   implicit none

contains

   subroutine sub( s )
   ! A call back procedure

      character(len=*), intent(in) :: s

      print *, "sub: message is ", s

   end subroutine

end module

program p

   use, intrinsic :: iso_c_binding, only : c_funloc, c_char, NUL => c_null_char, c_ptr, c_funptr,   &
                                           c_intptr_t, c_f_pointer, c_f_procpointer
   use IWin_m, only : LoadLibrary, GetProcAddress, GetDataAddress 
   use cb_m, only : sub

   procedure(), pointer :: foo

   blk_dll_load: block

      integer(c_intptr_t) :: m_handle
      character(kind=c_char, len=*), parameter :: DllName = c_char_"m.dll" // NUL
      character(kind=c_char, len=*), parameter :: DataName = c_char_"M_mp_PSUB" // NUL
      character(kind=c_char, len=*), parameter :: ProcName = c_char_"M_mp_FOO" // NUL
      type(c_funptr) :: cfp_foo
      type(c_funptr) :: cfp_sub_main
      type(c_ptr) :: cfp_sub_dll
      integer(c_intptr_t), pointer :: add_sub 

      m_handle = LoadLibrary( DllName )
      
      ! Set procedure pointer to user DLL method
      cfp_foo = GetProcAddress( m_handle, ProcName )
      call c_f_procpointer( cfp_foo, foo )
      
      ! Set procedure pointer in the user DLL!!
      cfp_sub_main = c_funloc( sub )  ! Get address of callback procedure
      cfp_sub_dll = GetDataAddress( m_handle, DataName )
      call c_f_pointer( cfp_sub_dll, add_sub )
      ! Transfer the address of callback procedure to DLL pointer via an
      ! intermediary of integer(c_intptr_t) type
      add_sub = transfer( cfp_sub_main, mold=add_sub )
      
      ! Clean up
      add_sub => null()

   end block blk_dll_load

   call foo() ! Call user DLL method

   stop

end program

Upon execution using Intel Fortran 18.0,

 sub: message is Hello World!

Just fyi, the module with interfaces for Windows DLL management APIs that I used are:

module IWin_m

   use, intrinsic :: iso_c_binding, only : c_char, c_int, c_intptr_t, c_ptr, c_funptr

   implicit none

   interface

      function LoadLibrary(lpLibName) bind(C, NAME='LoadLibraryA') result(RetVal)
      !DIR$ ATTRIBUTES STDCALL :: LoadLibrary

         import :: c_char, c_intptr_t

         !.. Argument list
         character(kind=c_char, len=1) :: lpLibName(*)
         !.. Function result
         integer(c_intptr_t) :: RetVal

      end function LoadLibrary

      function GetProcAddress(lpLibHandle, lpProcName) bind(C, NAME='GetProcAddress') result(RetVal)
      !DIR$ ATTRIBUTES STDCALL :: GetProcAddress

        import :: c_intptr_t, c_char, c_funptr

         !.. Argument list
         integer(c_intptr_t), value :: lpLibHandle
         character(kind=c_char)  :: lpProcName(*)
         !.. Function result
         type(c_funptr) :: RetVal

      end function GetProcAddress

      function GetDataAddress(lpLibHandle, lpProcName) bind(C, NAME='GetProcAddress') result(RetVal)
      !DIR$ ATTRIBUTES STDCALL :: GetDataAddress

        import :: c_intptr_t, c_char, c_ptr

         !.. Argument list
         integer(c_intptr_t), value :: lpLibHandle
         character(kind=c_char)  :: lpProcName(*)
         !.. Function result
         type(c_ptr) :: RetVal

      end function GetDataAddress

   end interface

end module