diff options
author | Elena Pourmal <epourmal@hdfgroup.org> | 2008-05-03 23:39:37 (GMT) |
---|---|---|
committer | Elena Pourmal <epourmal@hdfgroup.org> | 2008-05-03 23:39:37 (GMT) |
commit | dcad778b42d371c5429b913c65ec5c32f658d94e (patch) | |
tree | 3aa9f6ad4ef79064db548aa0ff692d2d1c6bbb51 /fortran/src/H5_ff.f90 | |
parent | 8090e1c6035e784402f8185434f291b63fe1d7c2 (diff) | |
download | hdf5-dcad778b42d371c5429b913c65ec5c32f658d94e.zip hdf5-dcad778b42d371c5429b913c65ec5c32f658d94e.tar.gz hdf5-dcad778b42d371c5429b913c65ec5c32f658d94e.tar.bz2 |
[svn-r14923] Maintenance: This check-in merges changes from the fortran_1_8 branch back into the trunk (up to revision 14921)
Platforms tested: kagiso with g95 and Intel compilers; more testing will be done after checking in a fresh
copy from the trunk. New code itself was tested with all Fortran compilers available at THG
Diffstat (limited to 'fortran/src/H5_ff.f90')
-rw-r--r-- | fortran/src/H5_ff.f90 | 366 |
1 files changed, 188 insertions, 178 deletions
diff --git a/fortran/src/H5_ff.f90 b/fortran/src/H5_ff.f90 index eeffa34..899ce00 100644 --- a/fortran/src/H5_ff.f90 +++ b/fortran/src/H5_ff.f90 @@ -13,8 +13,9 @@ ! access to either file, you may request a copy from help@hdfgroup.org. * ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! - MODULE H5LIB - CONTAINS +MODULE H5LIB + +CONTAINS !---------------------------------------------------------------------- ! Name: h5open_f ! @@ -37,18 +38,18 @@ ! ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5open_f(error) + SUBROUTINE h5open_f(error) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5open_f !DEC$endif ! - USE H5GLOBAL + USE H5GLOBAL - IMPLICIT NONE - INTEGER, INTENT(OUT) :: error - INTEGER :: error_0, error_1, error_2, error_3 + IMPLICIT NONE + INTEGER, INTENT(OUT) :: error + INTEGER :: error_0, error_1, error_2, error_3 ! INTEGER, EXTERNAL :: h5init_types_c ! INTEGER, EXTERNAL :: h5init_flags_c ! INTEGER, EXTERNAL :: h5init1_flags_c @@ -57,78 +58,87 @@ ! ! MS FORTRAN needs explicit interfaces for C functions called here. ! - INTERFACE - INTEGER FUNCTION h5open_c() - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5OPEN_C'::h5open_c - !DEC$ ENDIF - END FUNCTION h5open_c - END INTERFACE - INTERFACE - INTEGER FUNCTION h5init_types_c(p_types, f_types, i_types) - USE H5GLOBAL - INTEGER(HID_T), DIMENSION(PREDEF_TYPES_LEN) :: p_types - INTEGER(HID_T), DIMENSION(FLOATING_TYPES_LEN) :: f_types - INTEGER(HID_T), DIMENSION(INTEGER_TYPES_LEN) :: i_types - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5INIT_TYPES_C'::h5init_types_c - !DEC$ ENDIF - END FUNCTION h5init_types_c - END INTERFACE - INTERFACE - INTEGER FUNCTION h5init_flags_c(i_H5D_flags, & - i_H5F_flags, & - i_H5FD_flags, & - i_H5FD_hid_flags, & - i_H5G_flags, & - i_H5I_flags, & - i_H5P_flags, & - i_H5R_flags, & - i_H5S_flags, & - i_H5T_flags, & - i_H5Z_flags) - USE H5GLOBAL - INTEGER i_H5F_flags(H5F_FLAGS_LEN) - INTEGER i_H5G_flags(H5G_FLAGS_LEN) - INTEGER i_H5D_flags(H5D_FLAGS_LEN) - INTEGER i_H5FD_flags(H5FD_FLAGS_LEN) - INTEGER(HID_T) i_H5FD_hid_flags(H5FD_HID_FLAGS_LEN) - INTEGER i_H5I_flags(H5I_FLAGS_LEN) - INTEGER(HID_T) i_H5P_flags(H5P_FLAGS_LEN) - INTEGER i_H5R_flags(H5R_FLAGS_LEN) - INTEGER i_H5S_flags(H5S_FLAGS_LEN) - INTEGER i_H5T_flags(H5T_FLAGS_LEN) - INTEGER i_H5Z_flags(H5Z_FLAGS_LEN) + INTERFACE + INTEGER FUNCTION h5open_c() + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5OPEN_C'::h5open_c + !DEC$ ENDIF + END FUNCTION h5open_c + END INTERFACE + INTERFACE + INTEGER FUNCTION h5init_types_c(p_types, f_types, i_types) + USE H5GLOBAL + INTEGER(HID_T), DIMENSION(PREDEF_TYPES_LEN) :: p_types + INTEGER(HID_T), DIMENSION(FLOATING_TYPES_LEN) :: f_types + INTEGER(HID_T), DIMENSION(INTEGER_TYPES_LEN) :: i_types + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5INIT_TYPES_C'::h5init_types_c + !DEC$ ENDIF + END FUNCTION h5init_types_c + END INTERFACE + INTERFACE + INTEGER FUNCTION h5init_flags_c(i_H5D_flags, & + i_H5F_flags, & + i_H5FD_flags, & + i_H5FD_hid_flags, & + i_H5G_flags, & + i_H5I_flags, & + i_H5L_flags, & + i_H5O_flags, & + i_H5P_flags, & + i_H5R_flags, & + i_H5S_flags, & + i_H5T_flags, & + i_H5Z_flags, & + i_H5generic_flags) + USE H5GLOBAL + INTEGER i_H5F_flags(H5F_FLAGS_LEN) + INTEGER i_H5G_flags(H5G_FLAGS_LEN) + INTEGER i_H5D_flags(H5D_FLAGS_LEN) + INTEGER i_H5FD_flags(H5FD_FLAGS_LEN) + INTEGER(HID_T) i_H5FD_hid_flags(H5FD_HID_FLAGS_LEN) + INTEGER i_H5I_flags(H5I_FLAGS_LEN) + INTEGER i_H5L_flags(H5L_FLAGS_LEN) + INTEGER i_H5O_flags(H5O_FLAGS_LEN) + INTEGER(HID_T) i_H5P_flags(H5P_FLAGS_LEN) + INTEGER i_H5R_flags(H5R_FLAGS_LEN) + INTEGER i_H5S_flags(H5S_FLAGS_LEN) + INTEGER i_H5T_flags(H5T_FLAGS_LEN) + INTEGER i_H5Z_flags(H5Z_FLAGS_LEN) + INTEGER i_H5generic_flags(H5generic_FLAGS_LEN) !DEC$ IF DEFINED(HDF5F90_WINDOWS) !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5INIT_FLAGS_C'::h5init_flags_c !DEC$ ENDIF - END FUNCTION h5init_flags_c - END INTERFACE - INTERFACE - INTEGER FUNCTION h5init1_flags_c( i_H5LIB_flags ) - USE H5GLOBAL - INTEGER i_H5LIB_flags(H5LIB_FLAGS_LEN) - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5INIT1_FLAGS_C'::h5init1_flags_c - !DEC$ ENDIF - END FUNCTION h5init1_flags_c - END INTERFACE - error_0 = h5open_c() - error_1 = h5init_types_c(predef_types, floating_types, integer_types) - error_2 = h5init_flags_c(H5D_flags, & - H5F_flags, & - H5FD_flags, & - H5FD_hid_flags, & - H5G_flags, & - H5I_flags, & - H5P_flags, & - H5R_flags, & - H5S_flags, & - H5T_flags, & - H5Z_flags) - error_3 = h5init1_flags_c(H5LIB_flags ) - error = error_0 + error_1 + error_2 + error_3 - END SUBROUTINE h5open_f + END FUNCTION h5init_flags_c + END INTERFACE + INTERFACE + INTEGER FUNCTION h5init1_flags_c( i_H5LIB_flags ) + USE H5GLOBAL + INTEGER i_H5LIB_flags(H5LIB_FLAGS_LEN) + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5INIT1_FLAGS_C'::h5init1_flags_c + !DEC$ ENDIF + END FUNCTION h5init1_flags_c + END INTERFACE + error_0 = h5open_c() + error_1 = h5init_types_c(predef_types, floating_types, integer_types) + error_2 = h5init_flags_c(H5D_flags, & + H5F_flags, & + H5FD_flags, & + H5FD_hid_flags, & + H5G_flags, & + H5I_flags, & + H5L_flags, & + H5O_flags, & + H5P_flags, & + H5R_flags, & + H5S_flags, & + H5T_flags, & + H5Z_flags, & + H5generic_flags) + error_3 = h5init1_flags_c(H5LIB_flags ) + error = error_0 + error_1 + error_2 + error_3 + END SUBROUTINE h5open_f !---------------------------------------------------------------------- ! Name: h5close_f @@ -153,49 +163,49 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5close_f(error) + SUBROUTINE h5close_f(error) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5close_f !DEC$endif ! - USE H5GLOBAL + USE H5GLOBAL - IMPLICIT NONE - INTEGER :: error_1, error_2 - INTEGER, INTENT(OUT) :: error -! INTEGER, EXTERNAL :: h5close_types_c, h5close_c - INTERFACE - INTEGER FUNCTION h5close_c() - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5CLOSE_C'::h5close_c - !DEC$ ENDIF - END FUNCTION h5close_c - END INTERFACE - INTERFACE - INTEGER FUNCTION h5close_types_c(p_types, P_TYPES_LEN, & - f_types, F_TYPES_LEN, & - i_types, I_TYPES_LEN ) - USE H5GLOBAL - INTEGER P_TYPES_LEN - INTEGER F_TYPES_LEN - INTEGER I_TYPES_LEN - INTEGER(HID_T), DIMENSION(P_TYPES_LEN) :: p_types - INTEGER(HID_T), DIMENSION(F_TYPES_LEN) :: f_types - INTEGER(HID_T), DIMENSION(I_TYPES_LEN) :: i_types - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5CLOSE_TYPES_C'::h5close_types_c - !DEC$ ENDIF - END FUNCTION h5close_types_c - END INTERFACE - error_1 = h5close_types_c(predef_types, PREDEF_TYPES_LEN, & - floating_types, FLOATING_TYPES_LEN, & - integer_types, INTEGER_TYPES_LEN ) - error_2 = h5close_c() - error = error_1 + error_2 + IMPLICIT NONE + INTEGER :: error_1, error_2 + INTEGER, INTENT(OUT) :: error + ! INTEGER, EXTERNAL :: h5close_types_c, h5close_c + INTERFACE + INTEGER FUNCTION h5close_c() + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5CLOSE_C'::h5close_c + !DEC$ ENDIF + END FUNCTION h5close_c + END INTERFACE + INTERFACE + INTEGER FUNCTION h5close_types_c(p_types, P_TYPES_LEN, & + f_types, F_TYPES_LEN, & + i_types, I_TYPES_LEN ) + USE H5GLOBAL + INTEGER P_TYPES_LEN + INTEGER F_TYPES_LEN + INTEGER I_TYPES_LEN + INTEGER(HID_T), DIMENSION(P_TYPES_LEN) :: p_types + INTEGER(HID_T), DIMENSION(F_TYPES_LEN) :: f_types + INTEGER(HID_T), DIMENSION(I_TYPES_LEN) :: i_types + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5CLOSE_TYPES_C'::h5close_types_c + !DEC$ ENDIF + END FUNCTION h5close_types_c + END INTERFACE + error_1 = h5close_types_c(predef_types, PREDEF_TYPES_LEN, & + floating_types, FLOATING_TYPES_LEN, & + integer_types, INTEGER_TYPES_LEN ) + error_2 = h5close_c() + error = error_1 + error_2 - END SUBROUTINE h5close_f + END SUBROUTINE h5close_f !---------------------------------------------------------------------- ! Name: h5get_libversion_f @@ -219,29 +229,29 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5get_libversion_f(majnum, minnum, relnum, error) + SUBROUTINE h5get_libversion_f(majnum, minnum, relnum, error) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5get_libversion_f !DEC$endif ! - USE H5GLOBAL - - IMPLICIT NONE - INTEGER, INTENT(OUT) :: majnum, minnum, relnum, error - INTERFACE - INTEGER FUNCTION h5get_libversion_c(majnum, minnum, relnum) - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5GET_LIBVERSION_C'::h5get_libversion_c - !DEC$ ENDIF - INTEGER, INTENT(OUT) :: majnum, minnum, relnum - END FUNCTION h5get_libversion_c - END INTERFACE - - error = h5get_libversion_c(majnum, minnum, relnum) - - END SUBROUTINE h5get_libversion_f + USE H5GLOBAL + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: majnum, minnum, relnum, error + INTERFACE + INTEGER FUNCTION h5get_libversion_c(majnum, minnum, relnum) + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5GET_LIBVERSION_C'::h5get_libversion_c + !DEC$ ENDIF + INTEGER, INTENT(OUT) :: majnum, minnum, relnum + END FUNCTION h5get_libversion_c + END INTERFACE + + error = h5get_libversion_c(majnum, minnum, relnum) + + END SUBROUTINE h5get_libversion_f !---------------------------------------------------------------------- ! Name: h5check_version_f @@ -265,30 +275,30 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5check_version_f(majnum, minnum, relnum, error) + SUBROUTINE h5check_version_f(majnum, minnum, relnum, error) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5check_version_f !DEC$endif ! - USE H5GLOBAL - - IMPLICIT NONE - INTEGER, INTENT(IN) :: majnum, minnum, relnum - INTEGER, INTENT(OUT) :: error - INTERFACE - INTEGER FUNCTION h5check_version_c(majnum, minnum, relnum) - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5CHECK_VERSION_C'::h5check_version_c - !DEC$ ENDIF - INTEGER, INTENT(IN) :: majnum, minnum, relnum - END FUNCTION h5check_version_c - END INTERFACE - - error = h5check_version_c(majnum, minnum, relnum) - - END SUBROUTINE h5check_version_f + USE H5GLOBAL + + IMPLICIT NONE + INTEGER, INTENT(IN) :: majnum, minnum, relnum + INTEGER, INTENT(OUT) :: error + INTERFACE + INTEGER FUNCTION h5check_version_c(majnum, minnum, relnum) + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5CHECK_VERSION_C'::h5check_version_c + !DEC$ ENDIF + INTEGER, INTENT(IN) :: majnum, minnum, relnum + END FUNCTION h5check_version_c + END INTERFACE + + error = h5check_version_c(majnum, minnum, relnum) + + END SUBROUTINE h5check_version_f !---------------------------------------------------------------------- ! Name: h5garbage_collect_f @@ -310,28 +320,28 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5garbage_collect_f(error) + SUBROUTINE h5garbage_collect_f(error) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5garbage_collect_f !DEC$endif ! - USE H5GLOBAL + USE H5GLOBAL + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: error + INTERFACE + INTEGER FUNCTION h5garbage_collect_c() + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5GARBAGE_COLLECT_C'::h5garbage_collect_c + !DEC$ ENDIF + END FUNCTION h5garbage_collect_c + END INTERFACE + + error = h5garbage_collect_c() - IMPLICIT NONE - INTEGER, INTENT(OUT) :: error - INTERFACE - INTEGER FUNCTION h5garbage_collect_c() - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5GARBAGE_COLLECT_C'::h5garbage_collect_c - !DEC$ ENDIF - END FUNCTION h5garbage_collect_c - END INTERFACE - - error = h5garbage_collect_c() - - END SUBROUTINE h5garbage_collect_f + END SUBROUTINE h5garbage_collect_f !---------------------------------------------------------------------- ! Name: h5dont_atexit_f @@ -353,26 +363,26 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5dont_atexit_f(error) + SUBROUTINE h5dont_atexit_f(error) ! !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_DLL) !DEC$attributes dllexport :: h5dont_atexit_f !DEC$endif ! - USE H5GLOBAL - - IMPLICIT NONE - INTEGER, INTENT(OUT) :: error - INTERFACE - INTEGER FUNCTION h5dont_atexit_c() - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5DONT_ATEXIT_C'::h5dont_atexit_c - !DEC$ ENDIF - END FUNCTION h5dont_atexit_c - END INTERFACE - - error = h5dont_atexit_c() - - END SUBROUTINE h5dont_atexit_f - END MODULE H5LIB + USE H5GLOBAL + + IMPLICIT NONE + INTEGER, INTENT(OUT) :: error + INTERFACE + INTEGER FUNCTION h5dont_atexit_c() + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5DONT_ATEXIT_C'::h5dont_atexit_c + !DEC$ ENDIF + END FUNCTION h5dont_atexit_c + END INTERFACE + + error = h5dont_atexit_c() + + END SUBROUTINE h5dont_atexit_f +END MODULE H5LIB |