diff --git a/test/generic_data_plugin.f90 b/test/generic_data_plugin.f90 new file mode 100644 index 0000000..dc66c41 --- /dev/null +++ b/test/generic_data_plugin.f90 @@ -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 +! +! +! 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 + 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 + 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 diff --git a/test/test_generic_client.f90 b/test/test_generic_client.f90 new file mode 100644 index 0000000..a6105be --- /dev/null +++ b/test/test_generic_client.f90 @@ -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 diff --git a/test/test_generic_host.f90 b/test/test_generic_host.f90 new file mode 100644 index 0000000..772c7ee --- /dev/null +++ b/test/test_generic_host.f90 @@ -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