Fortran dynamic libraries, load at runtime?

后端 未结 1 1213
予麋鹿
予麋鹿 2021-01-06 05:37

Is it possible to have a Fortran program load a Fortran library at run time? If so, would it be possible to modify a function and recompile only the library to have the orig

相关标签:
1条回答
  • 2021-01-06 06:01

    Here are some few links that can be helpfull:

    • This page on rosettacode.org which gives complete example with details and discuss implementation on linux and MACOS
    • This intel forum post where Steve Lionel give some advice on how to do the dynamic loading with ifort
    • this IBM page with a great explanation of dynamic libraries and their usage

    If you want a small easy to understand code, keep reading. Few days ago, I was playing with dynamic loading. My test code below might be of help to you. However I work in the linux environment and you might have to adapt few thing here and there for it to work on your OS X environment. The rosettacode.org link above will come handy to help you.

    Here is the code for the test dynamic lib

    [username@hostname:~/test]$cat test.f90
    
    module test
        use, intrinsic :: iso_c_binding
    contains
        subroutine t_times2(v_in, v_out) bind(c, name='t_times2')
            integer, intent(in) :: v_in
            integer, intent(out) :: v_out
            !
            v_out=v_in*2
        end subroutine t_times2
        !
        subroutine t_square(v_in, v_out) bind(c, name='t_square')
            integer(c_int), intent(in) :: v_in
            integer(c_int), intent(out) :: v_out
            !
            v_out=v_in**2
        end subroutine t_square
    end module test
    

    Compiled as

    [username@hostname:~/test]$gfortran -c test.f90
    [username@hostname:~/test]$gfortran  -shared -o test.so test.o
    

    Here is the test program

    [username@hostname:~/test]$cat example.f90
    program example
        use :: iso_c_binding
    implicit none
    
        integer(c_int), parameter :: rtld_lazy=1 ! value extracte from the C header file
        integer(c_int), parameter :: rtld_now=2 ! value extracte from the C header file
        !
        ! interface to linux API
        interface
            function dlopen(filename,mode) bind(c,name="dlopen")
                ! void *dlopen(const char *filename, int mode);
                use iso_c_binding
                implicit none
                type(c_ptr) :: dlopen
                character(c_char), intent(in) :: filename(*)
                integer(c_int), value :: mode
            end function
    
            function dlsym(handle,name) bind(c,name="dlsym")
                ! void *dlsym(void *handle, const char *name);
                use iso_c_binding
                implicit none
                type(c_funptr) :: dlsym
                type(c_ptr), value :: handle
                character(c_char), intent(in) :: name(*)
            end function
    
            function dlclose(handle) bind(c,name="dlclose")
                ! int dlclose(void *handle);
                use iso_c_binding
                implicit none
                integer(c_int) :: dlclose
                type(c_ptr), value :: handle
            end function
        end interface
    
        ! Define interface of call-back routine.
        abstract interface
            subroutine called_proc (i, i2) bind(c)
                use, intrinsic :: iso_c_binding
                integer(c_int), intent(in) :: i
                integer(c_int), intent(out) :: i2
            end subroutine called_proc
        end interface
    
        ! testing the dynamic loading
        integer i, i2
        type(c_funptr) :: proc_addr
        type(c_ptr) :: handle
        character(256) :: pName, lName
    
        procedure(called_proc), bind(c), pointer :: proc
        !
        i = 15
    
        handle=dlopen("./test.so"//c_null_char, RTLD_LAZY)
        if (.not. c_associated(handle))then
            print*, 'Unable to load DLL ./test.so'
            stop
        end if
        !
        proc_addr=dlsym(handle, "t_times2"//c_null_char)
        if (.not. c_associated(proc_addr))then
            write(*,*) 'Unable to load the procedure t_times2'
            stop
        end if
        call c_f_procpointer( proc_addr, proc )
        call proc(i,i2)
        write(*,*) "t_times2, i2=", i2
        !
        proc_addr=dlsym( handle, "t_square"//c_null_char )
        if ( .not. c_associated(proc_addr) )then
            write(*,*)'Unable to load the procedure t_square'
            stop
        end if
        call c_f_procpointer(proc_addr, proc)
        call proc(i,i2)
        write(*,*) "t_square, i2=", i2
    contains
    end program example
    

    Compiled and run as:

    [username@hostname:~/test]$gfortran -o example example.f90 -ldl
    [username@hostname:~/test]$./example
    t_times2, i2=          30
    t_square, i2=         225
    [username@hostname:~/test]$
    
    0 讨论(0)
提交回复
热议问题