mx/durin
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases 1 Wiki Activity

Code from https://strucbio.biologie.uni-konstanz.de/xdswiki/index.php/LIB for testing plugin implementation

Browse Source
This commit is contained in:
graeme-winter
2018-08-13 09:18:44 +01:00
parent cc4d129932
commit dc34262acc
3 changed files with 634 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
test/generic_data_plugin.f90
+451
View File
@@ -0,0 +1,451 @@
!
! This is free and unencumbered software released into the public domain.!
! Anyone is free to copy, modify, publish, use, compile, sell, or distribute this software,
! either in source code form or as a compiled binary, for any purpose, commercial or non-commercial,
! and by any means.
!
! In jurisdictions that recognize copyright laws, the author or authors of this software dedicate
! any and all copyright interest in the software to the public domain. We make this dedication for
! the benefit of the public at large and to the detriment of our heirs and successors. We intend
! this dedication to be an overt act of relinquishment in perpetuity of all present and future
! rights to this software under copyright law.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT
! NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
! IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
! ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
! THE USE OR OTHER DEALINGS IN THE SOFTWARE.
!
! For more information, please refer to <http://unlicense.org/>
!
!
! vittorio.boccone@dectris.com
! Dectris Ltd., Taefernweg 1, 5405 Baden-Daettwil, Switzerland.
!
! (proof_of_concept)
!
! Interoperability with C in Fortran 2003
!
! Wrap up module to abstract the interface from
! http://cims.nyu.edu/~donev/Fortran/DLL/DLL.Forum.txt
!
module iso_c_utilities
use iso_c_binding ! intrinsic module
character(c_char), dimension(1), save, target, private :: dummy_string="?"
contains
function c_f_string(cptr) result(fptr)
! convert a null-terminated c string into a fortran character array pointer
type(c_ptr), intent(in) :: cptr ! the c address
character(kind=c_char), dimension(:), pointer :: fptr
interface ! strlen is a standard C function from <string.h>
function strlen(string) result(len) bind(C,name="strlen")
use iso_c_binding
type(c_ptr), value :: string ! a C pointer
end function
end interface
if(c_associated(cptr)) then
call c_f_pointer(fptr=fptr, cptr=cptr, shape=[strlen(cptr)])
else
! to avoid segfaults, associate fptr with a dummy target:
fptr=>dummy_string
end if
end function
end module iso_c_utilities
!
! Interoperability with C in Fortran 2003
!
! Wrap up module to abstract the interface from
! http://cims.nyu.edu/~donev/Fortran/DLL/DLL.Forum.txt
!
module dlfcn
use iso_c_binding
use iso_c_utilities
implicit none
private
public :: dlopen, dlsym, dlclose, dlerror ! dl api
! valid modes for mode in dlopen:
integer(c_int), parameter, public :: rtld_lazy=1, rtld_now=2, rtld_global=256, rtld_local=0
! obtained from the output of the previously listed c program
interface ! all we need is interfaces for the prototypes in <dlfcn.h>
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
! c strings should be declared as character arrays
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 function 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
end module dlfcn
!
! Generic handle for share-object like structures
!
! Wrap up module to abstract the interface from
! http://cims.nyu.edu/~donev/Fortran/DLL/DLL.Forum.txt
!
module generic_data_plugin
use iso_c_binding
implicit none
character(kind=c_char,len=1024) :: dll_filename
character(kind=c_char,len=1024) :: image_data_filename
integer(c_int) :: status
type(c_ptr) :: handle=c_null_ptr
INTEGER :: nx,ny,firstqm=0,lastqm=0 ! global variables that do not change
! firstqm, lastq mark ? characters in NAME_TEMPLATE that get replaced by an image number
CHARACTER(len=:), allocatable :: library ! global variable that does not change
LOGICAL :: is_open=.FALSE. ! set .TRUE. if library successfully opened
!public :: generic_open !, generic_header, generic_data, generic_clone
!
! Abstract interfaces for C mapped functions
!
!
! get_header -> dll_get_header
abstract interface
subroutine plugin_open(filename, info_array, error_flag) bind(C)
use iso_c_binding
integer(c_int) :: error_flag
character(kind=c_char) :: filename(*)
integer(c_int), dimension(1024) :: info_array
end subroutine plugin_open
subroutine plugin_close(error_flag) bind(C)
use iso_c_binding
integer (c_int) :: error_flag
end subroutine plugin_close
subroutine plugin_get_header(nx, ny, nbyte, qx, qy, number_of_frames, info_array, error_flag) bind(C)
use iso_c_binding
integer(c_int) :: nx, ny, nbyte, number_of_frames
real(c_float) :: qx, qy
integer(c_int) :: error_flag
integer(c_int), dimension(1024) :: info_array
end subroutine plugin_get_header
subroutine plugin_get_data(frame_number, nx, ny, data_array, info_array, error_flag) bind(C)
use iso_c_binding
integer(c_int) :: nx, ny, frame_number
integer(c_int) :: error_flag
integer(c_int), dimension(nx:ny) :: data_array
integer(c_int), dimension(1024) :: info_array
end subroutine plugin_get_data
end interface
! dynamically-linked procedures
procedure(plugin_open), pointer :: dll_plugin_open
procedure(plugin_get_header), pointer :: dll_plugin_get_header
procedure(plugin_get_data), pointer :: dll_plugin_get_data
procedure(plugin_close), pointer :: dll_plugin_close
contains
!
! Open the shared-object
subroutine generic_open(library, template_name, info_array, error_flag) ! Requirements:
! 'LIBRARY' input (including path, otherwise using LD_LIBRARY_PATH)
! 'TEMPLATE_NAME' input (the resource in image data masterfile)
! 'INFO' (integer array) input Array of (1024) integers:
! INFO(1) = Consumer ID (1:XDS)
! INFO(2) = Version Number of the Consumer software
! INFO(3:8) = Unused
! INFO(9:40) = 1024bit signature of the consumer software
! INFO(>41) = Unused
! 'INFO' (integer array) output Array of (1024) integers:
! INFO(1) = Vendor ID (1:Dectris)
! INFO(2) = Major Version number of the library
! INFO(3) = Minor Version number of the library
! INFO(4) = Parch Version number of the library
! INFO(5) = Linux timestamp of library creation
! INFO(6:8) = Unused
! INFO(9:40) = 1024bit signature of the library
! INFO(>41) = Unused
! 'ERROR_FLAG' output Return values
! 0 Success
! -1 Handle already exists
! -2 Cannot open Library
! -3 Function not found in library
! -4 Master file cannot be opened (coming from C function)
! -10 Consumer identity not supported (coming from C function)
! -11 Consumer identity could not be verified (coming from C function)
! -12 Consumer software version not supported (coming from C function)
use iso_c_binding
use iso_c_utilities
use dlfcn
implicit none
character(len=:), allocatable :: library, template_name
integer(c_int) :: error_flag
integer(c_int), dimension(1024) :: info_array
type(c_funptr) :: fun_plugin_open_ptr = c_null_funptr
type(c_funptr) :: fun_plugin_close_ptr = c_null_funptr
type(c_funptr) :: fun_plugin_get_header_ptr = c_null_funptr
type(c_funptr) :: fun_plugin_get_data_ptr = c_null_funptr
integer(c_int) :: external_error_flag
logical :: loading_error_flag = .false.
error_flag=0
write(6,*) "[generic_data_plugin] - INFO - generic_open"
write(6,*) " + library = <", library, ">"
write(6,*) " + template_name = <", template_name, ">"
if ( c_associated(handle) ) then
write(6,*) "[generic_data_plugin] - ERROR - 'handle' not null"
error_flag = -1
return
endif
dll_filename=library
error_flag = 0
write(6,*) " + dll_filename = <", trim(dll_filename)//C_NULL_CHAR, ">"
image_data_filename=trim(template_name)//C_NULL_CHAR
error_flag = 0
write(6,*) " + image_data_filename = <", trim(image_data_filename)//C_NULL_CHAR, ">"
!
! Open the DL:
! The use of IOR is not really proper...wait till Fortran 2008
handle=dlopen(trim(dll_filename)//C_NULL_CHAR, IOR(RTLD_NOW, RTLD_GLOBAL))
!
! Check if can use handle
if(.not.c_associated(handle)) then
write(6,*) "[generic_data_plugin] - ERROR - Cannot open Handle: ", c_f_string(dlerror())
error_flag = -2
return
end if
!
! Find the subroutines in the DL:
fun_plugin_get_data_ptr = DLSym(handle,"plugin_get_data")
if(.not.c_associated(fun_plugin_get_data_ptr)) then
write(6,*) "[generic_data_plugin] - ERROR in DLSym(handle,'plugin_get_data'): ", c_f_string(dlerror())
loading_error_flag = .true.
else
call c_f_procpointer(cptr=fun_plugin_get_data_ptr, fptr=dll_plugin_get_data)
endif
!
fun_plugin_get_header_ptr = DLSym(handle,"plugin_get_header")
if(.not.c_associated(fun_plugin_get_header_ptr)) then
write(6,*) "[generic_data_plugin] - ERROR in DLSym(handle,'plugin_get_header'): ",c_f_string(dlerror())
loading_error_flag = .true.
else
call c_f_procpointer(cptr=fun_plugin_get_header_ptr, fptr=dll_plugin_get_header)
endif
!
fun_plugin_open_ptr = DLSym(handle,"plugin_open")
if(.not.c_associated(fun_plugin_open_ptr)) then
write(6,*) "[generic_data_plugin] - ERROR in DLSym(handle,'plugin_open'): ", c_f_string(dlerror())
loading_error_flag = .true.
else
call c_f_procpointer(cptr=fun_plugin_open_ptr, fptr=dll_plugin_open)
endif
fun_plugin_close_ptr = DLSym(handle,"plugin_close")
if(.not.c_associated(fun_plugin_close_ptr)) then
write(6,*) "[generic_data_plugin] - ERROR in DLSym(handle,'plugin_close'): ", c_f_string(dlerror())
loading_error_flag = .true.
else
call c_f_procpointer(cptr=fun_plugin_close_ptr, fptr=dll_plugin_close)
endif
if (loading_error_flag) then
write(6,*) "[generic_data_plugin] - ERROR - Cannot map function(s) from the dll"
error_flag = -3
else
call dll_plugin_open(image_data_filename, info_array, external_error_flag)
error_flag = external_error_flag
endif
IF (error_flag == 0) is_open=.TRUE.
return
end subroutine generic_open
!
! Get the header
subroutine generic_get_header(nx, ny, nbyte, qx, qy, number_of_frames, info_array, error_flag)
! Requirements:
! 'NX' (integer) output Number of pixels along X
! 'NY' (integer) output Number of pixels along Y
! 'NBYTE' (integer) output Number of bytes in the image... X*Y*DEPTH
! 'QX' (4*REAL) output Pixel size
! 'QY' (4*REAL) output Pixel size
! 'NUMBER_OF_FRAMES' (integer) output Number of frames for the full datase. So far unused
! 'INFO' (integer array) input Array of (1024) integers:
! INFO(>1) = Unused
! 'INFO' (integer array) output Array of (1024) integers:
! INFO(1) = Vendor ID (1:Dectris)
! INFO(2) = Major Version number of the library
! INFO(3) = Minor Version number of the library
! INFO(4) = Patch Version number of the library
! INFO(5) = Linux timestamp of library creation
! INFO(6:64) = Reserved
! INFO(65:1024) = Dataset parameters
! 'ERROR_FLAG' output Return values
! 0 Success
! -1 Cannot open library
! -2 Cannot read header (will come from C function)
! -4 Cannot read dataset informations (will come from C function)
! -10 Error in the determination of the Dataset parameters (will come from C function)
!
use iso_c_binding
use iso_c_utilities
use dlfcn
implicit none
integer(c_int) :: nx, ny, nbyte, number_of_frames
real(c_float) :: qx, qy
integer(c_int) :: error_flag
integer(c_int) :: external_error_flag
integer(c_int), dimension(1024) :: info_array
error_flag=0
write(6,*) "[generic_data_plugin] - INFO - generic_get_header"
! Check if can use handle
if(.not.c_associated(handle)) then
write(6,*) "[generic_data_plugin] - ERROR - Cannot open Handle"
write(6,*) " ", c_f_string(dlerror())
error_flag = -1
return
end if
! finally, invoke the dynamically-linked subroutine:
call dll_plugin_get_header(nx, ny, nbyte, qx, qy, number_of_frames, info_array, external_error_flag)
return
end subroutine generic_get_header
!
! Dynamically map function and execute it
subroutine generic_get_data(frame_number, nx, ny, data_array, info_array, error_flag)
! Requirements:
! 'FRAME_NUMBER' (integer) input Number of frames for the full datase. So far unused
! 'NX' (integer) input Number of pixels along X
! 'NY' (integer) input Number of pixels along Y
! 'DATA_ARRAY' (integer array) output 1D array containing pixel data with lenght = NX*NY
! 'INFO' (integer array) output Array of (1024) integers:
! INFO(1) = Vendor ID (1:Dectris)
! INFO(2) = Major Version number of the library
! INFO(3) = Minor Version number of the library
! INFO(4) = Parch Version number of the library
! INFO(5) = Linux timestamp of library creation
! INFO(6:8) = Unused
! INFO(9:40) = 1024bit verification key
! INFO(41:44) = Image MD5 Checksum
! INFO() = Unused
! 'ERROR_FLAG' (integer) output Provides error state condition
! 0 Success
! -1 Cannot open library
! -2 Cannot open frame (will come from C function)
! -3 Datatype not supported (will come from C function)
! -4 Cannot read dataset informations (will come from C function)
! -10 MD5 Checksum Error
! -11 Verification key error
!
use iso_c_binding
use iso_c_utilities
use dlfcn
implicit none
integer(c_int) :: nx, ny, frame_number
integer(c_int) :: error_flag
integer(c_int), dimension(1024) :: info_array
integer(c_int), dimension (nx*ny) :: data_array
error_flag=0
call dll_plugin_get_data(frame_number, nx, ny, data_array, info_array, error_flag)
end subroutine generic_get_data
! Close the shared-object
!
subroutine generic_close(error_flag)
! Requirements:
! 'ERROR_FLAG' (integer) output Return values:
! 0 Success
! -1 Error closing Masterfile
! -2 Error closing Shared-object
use iso_c_binding
use iso_c_utilities
use dlfcn
implicit none
integer(c_int) :: error_flag
integer(c_int) :: external_error_flag
IF (.NOT.is_open) RETURN
! Check if can use handle
if(.not.c_associated(handle)) then
write(6,*) "[generic_data_plugin] - ERROR - Cannot open Handle"
write(6,*) " ", c_f_string(dlerror())
error_flag = -1
return
end if
write(6,*) "[generic_data_plugin] - INFO - 'call generic_close()'"
call dll_plugin_close(external_error_flag)
error_flag = external_error_flag
! now close the dl:
status=dlclose(handle)
if(status/=0) then
write(6,*) "[generic_data_plugin] - ERROR - Cannot open Handle"
write(6,*) " ", c_f_string(dlerror())
error_flag = -2
else
error_flag = 0
end if
return
end subroutine generic_close
end module generic_data_plugin
test/test_generic_client.f90
+83
View File
@@ -0,0 +1,83 @@
! This reads single data files which have a header of 7680 bytes
! Kay Diederichs 4/2017
! compile with
! ifort -fpic -shared -static-intel -qopenmp -traceback -sox test_generic_client.f90 -o libtest_generic_client.so
! or
! gfortran -c -fpic test_generic_client.f90 && ld -shared test_generic_client.o -L/usr/lib/gcc/x86_64-redhat-linux/4.8.5/ -lgfortran -o libtest_generic_client.so
! (attention: the above - from "gfortran" to "libtest_generic_client.so" - is one looong line)
! The resulting file can be used with a LIB=./libtest_generic_client.so line in XDS.INP, and enables
! reading of data files with a 7680 bytes header plus 1024*1024 pixels of integer data, without any record structure.
MODULE plugin_test_mod
CHARACTER :: fn_template*132=''
INTEGER :: lenfn,firstqm,lastqm
END MODULE
SUBROUTINE plugin_open(filename, info_array, error_flag) bind(C)
USE ISO_C_BINDING
USE plugin_test_mod
integer(c_int) :: error_flag
character(kind=c_char) :: filename(*)
integer(c_int), dimension(1024) :: info_array
INTEGER i
DO i=1,LEN(fn_template)
IF (filename(i)==C_NULL_CHAR) EXIT
fn_template(i:i)=filename(i)
END DO
WRITE(*,*)'libtest_generic_client v1.0; Kay Diederichs 20.4.17'
WRITE(*,*)'plugin_open: fn_template=',TRIM(fn_template)
lenfn=LEN_TRIM(fn_template)
info_array=0
error_flag=0
firstqm=INDEX(fn_template,'?')
lastqm =INDEX(fn_template,'?',BACK=.TRUE.)
END SUBROUTINE plugin_open
!
subroutine plugin_get_header(nx, ny, nbyte, qx, qy, number_of_frames, info_array, error_flag) bind(C)
USE ISO_C_BINDING
integer(c_int) :: nx, ny, nbyte, number_of_frames
real(c_float) :: qx, qy
integer(c_int) :: error_flag
integer(c_int), dimension(1024) :: info_array
! WRITE(*,*)'plugin_get_header was called'
nx=1024
ny=1024
nbyte=4
qx=0.172
qy=0.172
number_of_frames=9999
info_array=0
info_array(1)=0
error_flag=0
END SUBROUTINE plugin_get_header
!
SUBROUTINE plugin_get_data(frame_number, nx, ny, data_array, info_array, error_flag) BIND(C,NAME="plugin_get_data")
USE ISO_C_BINDING
USE plugin_test_mod
integer(c_int) :: nx, ny, frame_number
integer(c_int) :: error_flag
integer(c_int), dimension(1024) :: info_array
integer(c_int), dimension (nx*ny) :: data_array
! local variables
INTEGER k,i,dummy
CHARACTER :: fn*132,cformat*6='(i4.4)'
fn=fn_template
WRITE(cformat(3:5),'(i1,a1,i1)')lastqm-firstqm+1,'.',lastqm-firstqm+1
IF (frame_number>0) WRITE(fn(firstqm:lastqm),cformat) frame_number
! -qopenmp compile option needs to be used otherwise race in writing fn
OPEN(newunit=k,file=fn,action='READ',ACCESS='STREAM',form='unformatted')
WRITE(*,*)'plugin_get_data was called; frame_number,k=',frame_number,k
READ(k)(dummy,i=1,1920) ! read 15*512=7680 header bytes
READ(k) data_array
CLOSE(k)
error_flag=0
END SUBROUTINE plugin_get_data
!
SUBROUTINE plugin_close(error_flag) BIND(C,NAME="plugin_close")
USE ISO_C_BINDING
integer(c_int) :: error_flag
! WRITE(*,*)'plugin_close was called'
error_flag=0
END SUBROUTINE plugin_close
test/test_generic_host.f90
+100
View File
@@ -0,0 +1,100 @@
! Example test program for existing external library
! This should be saved in a file called test_generic_host.f90
! Kay Diederichs 4/2017
!
! compile with
! ifort -qopenmp generic_data_plugin.f90 test_generic_host.f90 -o test_generic_host
! or
! gfortran -O -fopenmp -ldl generic_data_plugin.f90 test_generic.f90 -o test_generic_host
! run with
! ./test_generic_host < test.in
! To test the dectris-neggia library, one could use this test.in:
!/usr/local/lib64/dectris-neggia.so
!/scratch/data/Eiger_16M_Nov2015/2015_11_10/insu6_1_??????.h5
!1 900
!
! The OMP_NUM_THREADS environment variable may be used for benchmarks!
PROGRAM test_generic_host
USE generic_data_plugin, ONLY: library, firstqm, lastqm, nx, ny, is_open, &
generic_open, generic_get_header, generic_get_data, generic_close
IMPLICIT NONE
INTEGER :: ier,nxny,ilow,ihigh,nbyte,info_array(1024), &
number_of_frames,len,numfrm
INTEGER, ALLOCATABLE :: iframe(:)
REAL :: qx,qy,avgcounts
CHARACTER(len=:), ALLOCATABLE :: master_file
CHARACTER(len=512) :: ACTNAM
! what should be done?
WRITE(*,*)'enter parameter of LIB= keyword:'
READ(*,'(a)') actnam
library=TRIM(actnam)
WRITE(*,*)'enter parameter of NAME_TEMPLATE_OF_DATA_FRAMES= keyword:'
READ(*,'(a)') actnam
WRITE(*,*)'enter parameters of the DATA_RANGE= keyword:'
READ(*,*) ilow,ihigh
! set some more module variables
firstqm=INDEX(actnam,'?') ! qm means question mark
lastqm =INDEX(actnam,'?',BACK=.TRUE.)
len =LEN_TRIM(actnam)
IF (actnam(len-2:len)=='.h5')THEN
master_file=actnam(:len-9)//'master.h5'
PRINT*,'master_file=',TRIM(master_file)
ELSE
master_file=TRIM(actnam)
ENDIF
info_array(1) = 1 ! 1=XDS (generic_open may check this)
info_array(2) = 123456789 ! better: e.g. 20160510; generic_open may check this
! initialize
CALL generic_open(library, master_file,info_array, ier)
IF (ier<0) THEN
WRITE(*,*)'error from generic_open, ier=',ier
STOP
END IF
is_open=.TRUE.
! get header and report
CALL generic_get_header(nx,ny,nbyte,qx,qy,number_of_frames,info_array,ier)
IF (ier<0) THEN
WRITE(*,*)'error from generic_get_header, ier=',ier
STOP
END IF
WRITE(*,'(a,3i6,2f10.6,i6)')'nx,ny,nbyte,qx,qy,number_of_frames=', &
nx,ny,nbyte,qx,qy,number_of_frames
WRITE(*,'(a,4i4,i12)')'INFO(1:5)=vendor/major version/minor version/patch/timestamp=', &
info_array(1:5)
IF (info_array(1)==0) THEN
WRITE(*,*) 'generic_getfrm: data are not vendor-specific',info_array(1) ! 1=Dectris
ELSE IF (info_array(1)==1) THEN
WRITE(*,*) 'generic_getfrm: data are from Dectris'
END IF
nxny=nx*ny
avgcounts=0.
! read the data (possibly in parallel)
!$omp parallel default(shared) private(numfrm,iframe,info_array,ier)
ALLOCATE(iframe(nxny))
!$omp do reduction(+:avgcounts)
DO numfrm=ilow,ihigh
CALL generic_get_data(numfrm, nx, ny, iframe, info_array, ier)
IF (ier<0) THEN
WRITE(*,*)'error from generic_get_data, numfrm, ier=',numfrm,ier
STOP
END IF
avgcounts=avgcounts + SUM(iframe)/REAL(nxny) ! do something with data
END DO
!$omp end parallel
WRITE(*,*)'average counts:',avgcounts/(ihigh-ilow+1)
! close
CALL generic_close(ier)
IF (ier<0) THEN
WRITE(*,*)'error from generic_close, ier=',ier
STOP
END IF
END PROGRAM test_generic_host