Richard E Maine wrote:

> It uses the C dl (dynamic link) library and is thus highly
> system-dependent in a way... but I've been able to port it to
> multiple Unix platforms without horribly much change. 
Attached is a file dlfcn.f90 which illustrates how to use C interop 
features in Fortran 2003 and the dl library to invoke a dll under UNIX. 
I provide code which works if procedure pointers are not available--the 
file dlfcn_aux.f90 provides an illegal hack that should work on most 
compilers. If procedure pointers are available, just uncomment those 
lines in the main program.

First compile the "dll" using the appropriate switches, for example:

f95 -c -pic shared.f90 -o shared.o
ld -shared shared.o -o shared.so

And then

f95 -c dlfcn_aux.f90
f95 -o dlfcn.x dlfcn.f90 -ldl dlfcn_aux.o

It seems to work nicely:

1.
dlfcn.x
  Enter the name of the DLL and the name of the DLL subroutine:
shared.so
MySub
  MySub: x=   1.0000000000000000

2.
dlfcn.x
  Enter the name of the DLL and the name of the DLL subroutine:
super
m
  Error in dlopen: super: cannot open shared object file: No such file or
directory

3.
dlfcn.x
  Enter the name of the DLL and the name of the DLL subroutine:
shared.so
YourSub
  Error in dlsym: ./shared.so: undefined symbol: YourSub

Aleks



MODULE DLFCN
   USE ISO_C_BINDING
   IMPLICIT NONE
   PRIVATE
   
   INTEGER, PARAMETER, PUBLIC :: RTLD_LAZY=1, RTLD_NOW=2, RTLD_GLOBAL=256, RTLD_LOCAL=0
   PUBLIC :: DLOpen, DLSym, DLClose, DLError, CToFortranString
   
   CHARACTER(C_CHAR), DIMENSION(1), SAVE, TARGET, PUBLIC :: dummy_string="?"
   
   INTERFACE
      FUNCTION DLOpen(file,mode) RESULT(handle) BIND(C,NAME="dlopen")
         ! void *dlopen(const char *file, int mode);
         USE ISO_C_BINDING
         CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: file
         INTEGER(C_INT), VALUE :: mode
         TYPE(C_PTR) :: handle
      END FUNCTION
      FUNCTION DLSym(handle,name) RESULT(funptr) BIND(C,NAME="dlsym")
         ! void *dlsym(void *handle, const char *name);
         USE ISO_C_BINDING
         TYPE(C_PTR), VALUE :: handle
         CHARACTER(C_CHAR), DIMENSION(*), INTENT(IN) :: name
         TYPE(C_FUNPTR) :: funptr ! A pointer
      END FUNCTION
      FUNCTION DLClose(handle) RESULT(status) BIND(C,NAME="dlclose")
         ! int dlclose(void *handle);
         USE ISO_C_BINDING
         TYPE(C_PTR), VALUE :: handle
         INTEGER(C_INT) :: status
      END FUNCTION
      FUNCTION DLError() RESULT(error) BIND(C,NAME="dlerror")
         ! char *dlerror(void);
         USE ISO_C_BINDING
         TYPE(C_PTR) :: error
      END FUNCTION         
   END INTERFACE
      
CONTAINS

   FUNCTION CToFortranString(cstr) RESULT(string)
      TYPE(C_PTR), VALUE :: cstr
      CHARACTER(C_CHAR), DIMENSION(:), POINTER :: string
      
      CHARACTER(KIND=C_CHAR,LEN=1024), POINTER :: error_string
      TYPE(C_PTR) :: error
      
      IF(C_ASSOCIATED(cstr)) THEN
         CALL C_F_POINTER(CPTR=cstr, FPTR=error_string) ! Not really standard-conforming
         CALL C_F_POINTER(CPTR=cstr, FPTR=string, SHAPE=[INDEX(error_string,C_NULL_CHAR)])
      ELSE
         string=>dummy_string
      END IF   
   
   END FUNCTION   

END MODULE

PROGRAM DLFCN_Test
   USE ISO_C_BINDING
   USE DLFCN
   USE Dynamic_Subroutine
   IMPLICIT NONE
   
   CHARACTER(KIND=C_CHAR,LEN=1024) :: dll_name, sub_name
   TYPE(C_PTR) :: handle=C_NULL_PTR
   TYPE(C_FUNPTR) :: funptr=C_NULL_FUNPTR
   INTEGER(C_INT) :: status
   
   INTERFACE
      ! If procedure pointers are not implemented, hack away
      SUBROUTINE CallDynamicSub(Sub,x)
         USE ISO_C_BINDING
         TYPE(C_FUNPTR), VALUE :: Sub ! Lie about this argument
         REAL(C_DOUBLE), VALUE :: x
      END SUBROUTINE        
   END INTERFACE
   ! Otherwise, do it properly:
   !PROCEDURE(MySub), POINTER :: dll_sub
   
   WRITE(*,*) "Enter the name of the DLL and the name of the DLL subroutine:"
   READ(*,"(A)") dll_name
   READ(*,"(A)") sub_name
   ! Convert to C convention:
   dll_name=TRIM(dll_name)//C_NULL_CHAR
   sub_name=TRIM(sub_name)//C_NULL_CHAR   
   
   handle=DLOpen(dll_name, IOR(RTLD_NOW, RTLD_GLOBAL))
      ! The use of IOR is not really proper...wait till Fortran 2008  
   IF(.NOT.C_ASSOCIATED(handle)) THEN
      WRITE(*,*) "Error in dlopen: ", CToFortranString(DLError())
      STOP
   END IF
   
   funptr=DLSym(handle,sub_name)
   IF(.NOT.C_ASSOCIATED(funptr)) THEN
      WRITE(*,*) "Error in dlsym: ", CToFortranString(DLError())
      STOP
   END IF
   ! If procedure pointers are not available, hack:
   CALL CallDynamicSub(funptr,1.0_c_double) ! Actually invoke the DLL
   ! Otherwise, do it properly:
   !   CALL C_F_PROCPOINTER(cptr=funptr, fptr=dll_sub)
   !   CALL dll_sub(1.0_c_double)
   
   status=DLClose(handle)
   IF(status/=0) THEN
      WRITE(*,*) "Error in dlclose: ", CToFortranString(DLError())
      STOP
   END IF

END PROGRAM





MODULE Dynamic_Subroutine
   IMPLICIT NONE
   ABSTRACT INTERFACE
      SUBROUTINE MySub(x) BIND(C)
         USE ISO_C_BINDING
         REAL(C_DOUBLE), VALUE :: x
      END SUBROUTINE
   END INTERFACE
END MODULE

SUBROUTINE CallDynamicSub(Sub,x)
   USE ISO_C_BINDING
   USE Dynamic_Subroutine
   IMPLICIT NONE
   PROCEDURE(MySub) :: Sub
   REAL(C_DOUBLE), VALUE :: x
   CALL Sub(x)
END SUBROUTINE     




SUBROUTINE MySub(x) BIND(C,NAME="MySub")
   USE ISO_C_BINDING
   REAL(C_DOUBLE), VALUE :: x
   WRITE(*,*) "MySub: x=",x
END SUBROUTINE