diff options
author | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2015-08-11 01:22:33 (GMT) |
---|---|---|
committer | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2015-08-11 01:22:33 (GMT) |
commit | 3b4696ccd16c2b98e2700a46bf7a5c76ef4a9764 (patch) | |
tree | f301ab5333168d7bfa691bee703dd076f569fc46 /fortran/test/tf.F90 | |
parent | 415eb5512b0726716b5f8f72de3dda11ecff8091 (diff) | |
download | hdf5-3b4696ccd16c2b98e2700a46bf7a5c76ef4a9764.zip hdf5-3b4696ccd16c2b98e2700a46bf7a5c76ef4a9764.tar.gz hdf5-3b4696ccd16c2b98e2700a46bf7a5c76ef4a9764.tar.bz2 |
[svn-r27489] reverted merge of branch
Diffstat (limited to 'fortran/test/tf.F90')
-rw-r--r-- | fortran/test/tf.F90 | 412 |
1 files changed, 0 insertions, 412 deletions
diff --git a/fortran/test/tf.F90 b/fortran/test/tf.F90 deleted file mode 100644 index 7d67f30..0000000 --- a/fortran/test/tf.F90 +++ /dev/null @@ -1,412 +0,0 @@ -!****h* root/fortran/test/tf.f90 -! -! NAME -! tf.f90 -! -! FUNCTION -! Contains subroutines which are needed in all the hdf5 fortran tests -! -! COPYRIGHT -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! Copyright by The HDF Group. * -! Copyright by the Board of Trustees of the University of Illinois. * -! All rights reserved. * -! * -! This file is part of HDF5. The full HDF5 copyright notice, including * -! terms governing use, modification, and redistribution, is contained in * -! the files COPYING and Copyright.html. COPYING can be found at the root * -! of the source code distribution tree; Copyright.html can be found at the * -! root level of an installed copy of the electronic HDF5 document set and * -! is linked from the top-level documents page. It can also be found at * -! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have * -! access to either file, you may request a copy from help@hdfgroup.org. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! -! CONTAINS SUBROUTINES -! write_test_status, check, verify, verifyLogical, verifyString, h5_fixname_f, -! h5_cleanup_f, h5_exit_f, h5_env_nocleanup_f,dreal_eqv -! -!***** - -#include "H5config_f.inc" - -MODULE TH5_MISC - - USE, INTRINSIC :: ISO_C_BINDING - - IMPLICIT NONE - - INTEGER, PARAMETER :: sp = SELECTED_REAL_KIND(5) ! This should map to REAL*4 on most modern processors - INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(10) ! This should map to REAL*8 on most modern processors - - ! generic compound datatype - TYPE, BIND(C) :: comp_datatype - REAL :: a - INTEGER :: x - DOUBLE PRECISION :: y - CHARACTER(KIND=C_CHAR) :: z - END TYPE comp_datatype - - PUBLIC :: H5_SIZEOF - INTERFACE H5_SIZEOF - MODULE PROCEDURE H5_SIZEOF_CMPD - MODULE PROCEDURE H5_SIZEOF_CHR - MODULE PROCEDURE H5_SIZEOF_I - MODULE PROCEDURE H5_SIZEOF_SP,H5_SIZEOF_DP - END INTERFACE - -CONTAINS - -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_TEST_DLL) -!DEC$attributes dllexport :: write_test_status -!DEC$endif - SUBROUTINE write_test_status( test_result, test_title, total_error) - - ! Writes the results of the tests - - IMPLICIT NONE - - INTEGER, INTENT(IN) :: test_result ! negative, --skip -- - ! 0 , passed - ! positive, failed - - CHARACTER(LEN=*), INTENT(IN) :: test_title ! Short description of test - INTEGER, INTENT(INOUT) :: total_error ! Accumulated error - -! Controls the output style for reporting test results - - CHARACTER(LEN=8) :: error_string - CHARACTER(LEN=8), PARAMETER :: success = ' PASSED ' - CHARACTER(LEN=8), PARAMETER :: failure = '*FAILED*' - CHARACTER(LEN=8), PARAMETER :: skip = '--SKIP--' - - - error_string = failure - IF (test_result == 0) THEN - error_string = success - ELSE IF (test_result == -1) THEN - error_string = skip - ENDIF - - WRITE(*, fmt = '(A, T72, A)') test_title, error_string - - IF(test_result.GT.0) total_error = total_error + test_result - - END SUBROUTINE write_test_status - - -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_TEST_DLL) -!DEC$attributes dllexport :: check -!DEC$endif - SUBROUTINE check(string,error,total_error) - CHARACTER(LEN=*) :: string - INTEGER :: error, total_error - IF (error .LT. 0) THEN - total_error=total_error+1 - WRITE(*,*) string, " FAILED" - ENDIF - RETURN - END SUBROUTINE check - -!---------------------------------------------------------------------- -! Name: h5_fixname_f -! -! Purpose: Create a file name from the a file base name. -! It is a fortran counterpart for the h5_fixname in ../../test/h5test.c -! -! Inputs: -! base_name - base name of the file -! fapl - file access property list -! Outputs: -! full_name - full file name -! hdferr: - error code -! Success: 0 -! Failure: -1 -! -! Programmer: Elena Pourmal -! September 13, 2002 -! -! -!---------------------------------------------------------------------- - SUBROUTINE h5_fixname_f(base_name, full_name, fapl, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_TEST_DLL) -!DEC$attributes dllexport :: h5_fixname_f -!DEC$endif - USE H5GLOBAL - IMPLICIT NONE - CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name - CHARACTER(LEN=*), INTENT(IN) :: full_name ! full name - INTEGER, INTENT(OUT) :: hdferr ! Error code - INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list - - INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string - INTEGER(SIZE_T) :: full_namelen ! Length of the full name character string -! INTEGER(HID_T) :: fapl_default - - INTERFACE - INTEGER FUNCTION h5_fixname_c(base_name, base_namelen, fapl, & - full_name, full_namelen) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_FIXNAME_C':: h5_fixname_c - !DEC$ ENDIF - !DEC$ATTRIBUTES reference :: base_name - !DEC$ATTRIBUTES reference :: full_name - CHARACTER(LEN=*), INTENT(IN) :: base_name - INTEGER(SIZE_T) :: base_namelen - INTEGER(HID_T), INTENT(IN) :: fapl - CHARACTER(LEN=*), INTENT(IN) :: full_name - INTEGER(SIZE_T) :: full_namelen - END FUNCTION h5_fixname_c - END INTERFACE - - base_namelen = LEN(base_name) - full_namelen = LEN(full_name) - hdferr = h5_fixname_c(base_name, base_namelen, fapl, & - full_name, full_namelen) - - END SUBROUTINE h5_fixname_f - -!---------------------------------------------------------------------- -! Name: h5_cleanup_f -! -! Purpose: Cleanups tests files -! It is a fortran counterpart for the h5_cleanup in ../../test/h5test.c -! -! Inputs: -! base_name - base name of the file -! fapl - file access property list -! Outputs: -! hdferr: - error code -! Success: 0 -! Failure: -1 -! -! Programmer: Elena Pourmal -! September 19, 2002 -! -! -!---------------------------------------------------------------------- - SUBROUTINE h5_cleanup_f(base_name, fapl, hdferr) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_TEST_DLL) -!DEC$attributes dllexport :: h5_cleanup_f -!DEC$endif - USE H5GLOBAL - IMPLICIT NONE - CHARACTER(LEN=*), INTENT(IN) :: base_name ! base name - INTEGER, INTENT(OUT) :: hdferr ! Error code - INTEGER(HID_T), INTENT(IN) :: fapl ! file access property list - - INTEGER(SIZE_T) :: base_namelen ! Length of the base name character string - - INTERFACE - INTEGER FUNCTION h5_cleanup_c(base_name, base_namelen, fapl) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_CLEANUP_C':: h5_cleanup_c - !DEC$ ENDIF - !DEC$ATTRIBUTES reference :: base_name - CHARACTER(LEN=*), INTENT(IN) :: base_name - INTEGER(SIZE_T) :: base_namelen - INTEGER(HID_T), INTENT(IN) :: fapl - END FUNCTION h5_cleanup_c - END INTERFACE - - base_namelen = LEN(base_name) - hdferr = h5_cleanup_c(base_name, base_namelen, fapl) - - END SUBROUTINE h5_cleanup_f - -!---------------------------------------------------------------------- -! Name: h5_exit_f -! -! Purpose: Exit application -! It is a fortran counterpart for the standard C 'exit()' routine -! Be careful not to overflow the exit value range since -! UNIX supports a very small range such as 1 byte. -! Therefore, exit(256) may end up as exit(0). -! -! Inputs: -! status - Status to return from application -! -! Outputs: -! none -! -! Programmer: Quincey Koziol -! December 14, 2004 -! -! -!---------------------------------------------------------------------- - SUBROUTINE h5_exit_f(status) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_TEST_DLL) -!DEC$attributes dllexport :: h5_exit_f -!DEC$endif - IMPLICIT NONE - INTEGER, INTENT(IN) :: status ! Return code - - INTERFACE - SUBROUTINE h5_exit_c(status) - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_EXIT_C':: h5_exit_c - !DEC$ ENDIF - INTEGER, INTENT(IN) :: status - END SUBROUTINE h5_exit_c - END INTERFACE - - CALL h5_exit_c(status) - - END SUBROUTINE h5_exit_f - -!---------------------------------------------------------------------- -! Name: h5_env_nocleanup_f -! -! Purpose: Uses the HDF5_NOCLEANUP environment variable in Fortran -! tests to determine if the output files should be removed -! -! Inputs: -! -! Outputs: HDF5_NOCLEANUP: .true. - don't remove test files -! .false. - remove test files -! -! Programmer: M.S. Breitenfeld -! September 30, 2008 -! -!---------------------------------------------------------------------- - SUBROUTINE h5_env_nocleanup_f(HDF5_NOCLEANUP) -! -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_TEST_DLL) -!DEC$attributes dllexport :: h5_env_nocleanup_f -!DEC$endif - IMPLICIT NONE - LOGICAL, INTENT(OUT) :: HDF5_NOCLEANUP ! Return code - INTEGER :: status - - INTERFACE - SUBROUTINE h5_env_nocleanup_c(status) - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5_ENV_NOCLEANUP_C':: h5_env_nocleanup_c - !DEC$ ENDIF - INTEGER :: status - END SUBROUTINE h5_env_nocleanup_c - END INTERFACE - - CALL h5_env_nocleanup_c(status) - - HDF5_NOCLEANUP = .FALSE. - IF(status.EQ.1) HDF5_NOCLEANUP = .TRUE. - - END SUBROUTINE h5_env_nocleanup_f - -! --------------------------------------------------------------------------------------------------- -! H5_SIZEOF routines -! -! NOTES -! (1) The Sun/Oracle compiler has the following restrictions on the SIZEOF intrinsic function: -! -! "The SIZEOF intrinsic cannot be applied to arrays of an assumed size, characters of a -! length that is passed, or subroutine calls or names. SIZEOF returns default INTEGER*4 data. -! If compiling for a 64-bit environment, the compiler will issue a warning if the result overflows -! the INTEGER*4 data range. To use SIZEOF in a 64-bit environment with arrays larger -! than the INTEGER*4 limit (2 Gbytes), the SIZEOF function and -! the variables receiving the result must be declared INTEGER*8." -! -! Thus, we can not overload the H5_SIZEOF function to handle arrays (as used in tH5P_F03.f90), or -! characters that do not have a set length (as used in tH5P_F03.f90), sigh... -! -! (2) F08+TS29113 requires C interoperable variable as argument for C_SIZEOF. -! -! (3) Unfortunately we need to wrap the C_SIZEOF/STORAGE_SIZE functions to handle different -! data types from the various tests. -! -! --------------------------------------------------------------------------------------------------- - -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_TEST_DLL) -!DEC$attributes dllexport :: h5_sizeof_cmpd -!DEC$endif - INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_CMPD(a) - IMPLICIT NONE - TYPE(comp_datatype), INTENT(in) :: a - -#ifdef H5_FORTRAN_FORTRAN_HAVE_C_SIZEOF - H5_SIZEOF_CMPD = C_SIZEOF(a) -#else - H5_SIZEOF_CMPD = SIZEOF(a) -#endif - - END FUNCTION H5_SIZEOF_CMPD - -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_TEST_DLL) -!DEC$attributes dllexport :: h5_sizeof_chr -!DEC$endif - INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_CHR(a) - IMPLICIT NONE - CHARACTER(LEN=1), INTENT(in) :: a - -#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE - H5_SIZEOF_CHR = storage_size(a, c_size_t)/storage_size(c_char_'a',c_size_t) -#else - H5_SIZEOF_CHR = SIZEOF(a) -#endif - - END FUNCTION H5_SIZEOF_CHR - -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_TEST_DLL) -!DEC$attributes dllexport :: h5_sizeof_i -!DEC$endif - INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_I(a) - IMPLICIT NONE - INTEGER, INTENT(in):: a - -#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE - H5_SIZEOF_I = storage_size(a, c_size_t)/storage_size(c_char_'a',c_size_t) -#else - H5_SIZEOF_I = SIZEOF(a) -#endif - - END FUNCTION H5_SIZEOF_I - - -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_TEST_DLL) -!DEC$attributes dllexport :: h5_sizeof_sp -!DEC$endif - INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_SP(a) - IMPLICIT NONE - REAL(sp), INTENT(in):: a - -#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE - H5_SIZEOF_SP = storage_size(a, c_size_t)/storage_size(c_char_'a',c_size_t) -#else - H5_SIZEOF_SP = SIZEOF(a) -#endif - - END FUNCTION H5_SIZEOF_SP - -!This definition is needed for Windows DLLs -!DEC$if defined(BUILD_HDF5_TEST_DLL) -!DEC$attributes dllexport :: h5_sizeof_dp -!DEC$endif - INTEGER(C_SIZE_T) FUNCTION H5_SIZEOF_DP(a) - IMPLICIT NONE - REAL(dp), INTENT(in):: a - -#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE - H5_SIZEOF_DP = storage_size(a, c_size_t)/storage_size(c_char_'a',c_size_t) -#else - H5_SIZEOF_DP = SIZEOF(a) -#endif - - END FUNCTION H5_SIZEOF_DP - -END MODULE TH5_MISC |