diff options
Diffstat (limited to 'fortran/src/H5Eff_F03.f90')
| -rw-r--r-- | fortran/src/H5Eff_F03.f90 | 154 |
1 files changed, 8 insertions, 146 deletions
diff --git a/fortran/src/H5Eff_F03.f90 b/fortran/src/H5Eff_F03.f90 index bf4797f..164f203 100644 --- a/fortran/src/H5Eff_F03.f90 +++ b/fortran/src/H5Eff_F03.f90 @@ -1,7 +1,7 @@ !****h* ROBODoc/H5E (F03) ! ! NAME -! H5L_PROVISIONAL +! H5E_PROVISIONAL ! ! FILE ! src/fortran/src/H5Eff_F03.f90 @@ -9,9 +9,9 @@ ! PURPOSE ! ! This file contains Fortran 90 and Fortran 2003 interfaces for H5E functions. -! It contains the same functions as H5Eff_DEPRECIATE.f90 but includes the +! It contains the same functions as H5Eff_F90.f90 but includes the ! Fortran 2003 functions and the interface listings. This file will be compiled -! instead of H5Eff_DEPRECIATE.f90 if Fortran 2003 functions are enabled. +! instead of H5Eff_F90.f90 if Fortran 2003 functions are enabled. ! ! ! COPYRIGHT @@ -44,24 +44,10 @@ MODULE H5E_PROVISIONAL CONTAINS - INTEGER FUNCTION h5eprint_def() bind(C) - - USE ISO_C_BINDING - IMPLICIT NONE - INTEGER :: hdferr - - PRINT*,'Inside h5eprint_def' -! STOP - -!!$ CALL h5eprint_f(hdferr) -!!$ h5eprint_def = hdferr - - END FUNCTION h5eprint_def - -!****s* H5E/h5eset_auto2_f +!****s* H5E/h5eset_auto_f ! ! NAME -! h5eset_auto2_f +! h5eset_auto_f ! ! PURPOSE ! Returns settings for automatic error stack traversal function and its data. @@ -82,9 +68,9 @@ CONTAINS ! M. Scot Breitenfeld ! July 10, 2009 ! -! Signature: +! Fortran2003 Interface: SUBROUTINE h5eset_auto_f(printflag, hdferr, estack_id, func, client_data) - USE ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING INTEGER , INTENT(IN) :: printflag INTEGER , INTENT(OUT) :: hdferr INTEGER(HID_T), INTENT(IN) , OPTIONAL :: estack_id @@ -96,7 +82,7 @@ CONTAINS TYPE(C_PTR) :: client_data_default INTERFACE INTEGER FUNCTION h5eset_auto2_c(printflag, estack_id, func, client_data) - USE ISO_C_BINDING + USE, INTRINSIC :: ISO_C_BINDING USE H5GLOBAL !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5ESET_AUTO2_C'::h5eset_auto2_c @@ -121,128 +107,4 @@ CONTAINS hdferr = h5eset_auto2_c(printflag, estack_id_default, func_default, client_data_default) END SUBROUTINE h5eset_auto_f -!****s* H5E/h5eget_auto_f -! -! NAME -! h5eget_auto_f -! -! PURPOSE -! Returns the settings for the automatic error stack traversal function and its data. -! -! Inputs: -! estack_id - Error stack identifier. H5E_DEFAULT_F indicates the current stack. -! Outputs: -! func - The function currently set to be called upon an error condition. -! client_data - Data currently set to be passed to the error function. -! hdferr - Returns 0 if successful and -1 if fails. -! -! AUTHOR -! M. Scot Breitenfeld -! July 10, 2009 -! -! Signature: - SUBROUTINE h5eget_auto_f(estack_id, op, client_data, hdferr) - USE ISO_C_BINDING - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: estack_id -!!$ TYPE(C_FUNPTR) :: op_f -!!$ TYPE(C_PTR) :: client_data_f - TYPE(C_FUNPTR) :: op - TYPE(C_PTR), VALUE :: client_data - INTEGER, INTENT(OUT) :: hdferr -!***** - INTEGER :: ret_func2 - !INTEGER(C_INT), DIMENSION(:), POINTER :: ptr_data - INTEGER, DIMENSION(1:1) :: array_shape - TYPE(C_PTR), TARGET :: f_ptr1 - INTEGER(C_INT) :: ptr_data - INTEGER(C_INT) :: i - TYPE(C_PTR) :: test - INTEGER, POINTER :: a - - INTEGER, TARGET :: j - TYPE(C_PTR) :: f_ptr2 - - INTERFACE - INTEGER FUNCTION h5eget_auto_c(estack_id, op, client_data, ret_func2) - USE ISO_C_BINDING - USE H5GLOBAL - IMPLICIT NONE - !DEC$IF DEFINED(HDF5F90_WINDOWS) - !DEC$ATTRIBUTES C,reference,decorate,alias:'H5EGET_AUTO_C'::h5eget_auto_c - !DEC$ENDIF - INTEGER(HID_T) :: estack_id - TYPE(C_FUNPTR) :: op - TYPE(C_PTR) :: client_data - INTEGER :: ret_func2 - END FUNCTION h5eget_auto_c - -!!$ TYPE(C_PTR) FUNCTION h5eget_auto_c2(estack_id, op, ret_func2) -!!$ USE ISO_C_BINDING -!!$ USE H5GLOBAL -!!$ IMPLICIT NONE -!!$ !DEC$IF DEFINED(HDF5F90_WINDOWS) -!!$ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5EGET_AUTO_C'::h5eget_auto_c -!!$ !DEC$ENDIF -!!$ INTEGER(HID_T) :: estack_id -!!$ TYPE(C_FUNPTR) :: op -!!$ INTEGER :: ret_func2 -!!$ END FUNCTION h5eget_auto_c2 - -!!$ SUBROUTINE process_buffer(estack_id, buffer) -!!$ USE, INTRINSIC :: ISO_C_BINDING -!!$ USE H5GLOBAL -!!$ INTEGER(HID_T) :: estack_id -!!$ TYPE(C_PTR) :: buffer -!!$ END SUBROUTINE process_buffer - - END INTERFACE - -! j = -9999 - - - f_ptr2 = c_loc(j) -! CALL process_buffer(estack_id,f_ptr2) - - hdferr = h5eget_auto_c(estack_id, op, f_ptr2, ret_func2) - -!!!!! PRINT*,c_associated(f_ptr2) -!!$ hdferr = h5eget_auto_c(estack_id, op, client_data, ret_func2) - - PRINT*,'fortran',j - stop - -! client_data = h5eget_auto_c2(estack_id, op, ret_func2) - -! PRINT*,'Is client_data associated',C_associated(client_data) -! PRINT*,'Is op_data associated',C_associated(op) - -! ALLOCATE(i(1:1)) -! CALL c_f_pointer(f_ptr2,a,[1]) -! CALL c_f_pointer(f_ptr2,i) -! PRINT*,i -! PRINT*,"Buffer in (F) = ", a(1) - -! stop - -! ALLOCATE(ptr_data(1:2)) -! ptr_data = 0 -! array_shape(1) = 1 -! CALL C_F_POINTER(client_data, ptr_data, array_shape) -! CALL C_F_POINTER(f_ptr2, i,(/ 1 /)) - -! ptr_data => f_ptr1(1) - -! PRINT*,'value in fortran',i - - -! Check to see if the user created their own function, -! otherwise we have to create a fortran version of the default - -!!$ IF(ret_func2.EQ.0)THEN -!!$ op = c_funloc(h5eprint_def) -!!$ END IF - - END SUBROUTINE h5eget_auto_f - END MODULE H5E_PROVISIONAL |