hdf5/fortran/test/tf.f90
Scot Breitenfeld a9c065c5ce [svn-r21248] Mereged the F2003 branch into the trunk.
Items merged: fortran directory, 
              src/libhdf5.settings.in 
              configure.in configure 
              MANIFEST

Tested: (all platforms used by daily tests, both with --enable-fortran and --enable-fortran2003)
2011-08-18 09:32:47 -05:00

363 lines
11 KiB
Fortran

!****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
!
!*****
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: verify_real
!DEC$endif
SUBROUTINE verify_real_kind_7(string,value,correct_value,total_error)
USE HDF5
INTEGER, PARAMETER :: real_kind_7 = SELECTED_REAL_KIND(Fortran_REAL_4) !should map to REAL*4 on most modern processors
CHARACTER(LEN=*) :: string
REAL(real_kind_7) :: value, correct_value
INTEGER :: total_error
IF (value .NE. correct_value) THEN
total_error=total_error+1
WRITE(*,*) "ERROR: INCORRECT REAL VALIDATION ", string
ENDIF
RETURN
END SUBROUTINE verify_real_kind_7
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_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_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
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: verify
!DEC$endif
SUBROUTINE verify(string,value,correct_value,total_error)
CHARACTER(LEN=*) :: string
INTEGER :: value, correct_value, total_error
IF (value .NE. correct_value) THEN
total_error=total_error+1
WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
ENDIF
RETURN
END SUBROUTINE verify
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: verify
!DEC$endif
SUBROUTINE verify_Fortran_INTEGER_4(string,value,correct_value,total_error)
USE HDF5
INTEGER, PARAMETER :: int_kind_8 = SELECTED_INT_KIND(Fortran_INTEGER_4) ! should map to INTEGER*4 on most modern processors
CHARACTER(LEN=*) :: string
INTEGER(int_kind_8) :: value, correct_value, total_error
IF (value .NE. correct_value) THEN
total_error=total_error+1
WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
ENDIF
RETURN
END SUBROUTINE verify_Fortran_INTEGER_4
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: verifyLogical
!DEC$endif
SUBROUTINE verifyLogical(string,value,correct_value,total_error)
CHARACTER(LEN=*) :: string
LOGICAL :: value, correct_value
INTEGER :: total_error
IF (value .NEQV. correct_value) THEN
total_error = total_error + 1
WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
ENDIF
RETURN
END SUBROUTINE verifyLogical
!This definition is needed for Windows DLLs
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$attributes dllexport :: verifyString
!DEC$endif
SUBROUTINE verifystring(string, value,correct_value,total_error)
CHARACTER*(*) :: string
CHARACTER*(*) :: value, correct_value
INTEGER :: total_error
IF (TRIM(value) .NE. TRIM(correct_value)) THEN
total_error = total_error + 1
WRITE(*,*) "ERROR: INCORRECT VALIDATION ", string
ENDIF
RETURN
END SUBROUTINE verifystring
!----------------------------------------------------------------------
! 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_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_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_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_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)THEN
HDF5_NOCLEANUP = .TRUE.
ENDIF
END SUBROUTINE h5_env_nocleanup_f