mirror of
https://github.com/HDFGroup/hdf5.git
synced 2025-02-11 16:01:00 +08:00
[svn-r27366] misc. clean-up
This commit is contained in:
Scot Breitenfeld
parent
0a8317aab7
commit
f71a46a99c
@ -1,10 +1,10 @@
|
||||
!****p* Program/H5test_kind
|
||||
!****p* Program/H5_buildiface
|
||||
!
|
||||
! NAME
|
||||
! Executable: H5test_kind
|
||||
! Executable: H5_buildiface
|
||||
!
|
||||
! FILE
|
||||
! fortran/src/H5test_kind.f90
|
||||
! fortran/src/H5_buildiface.f90
|
||||
!
|
||||
! PURPOSE
|
||||
! This stand alone program is used at build time to generate the program
|
||||
@ -93,208 +93,9 @@ PROGRAM test_kind
|
||||
' f_ptr = C_LOC(buf(1,1,1,1,1,1,1))' &
|
||||
/)
|
||||
|
||||
GOTO 10
|
||||
|
||||
! Generate program information:
|
||||
|
||||
WRITE(*,'(40(A,/))') &
|
||||
'!****h* ROBODoc/H5fortran_detect.f90',&
|
||||
'!',&
|
||||
'! NAME',&
|
||||
'! H5fortran_detect',&
|
||||
'! ',&
|
||||
'! PURPOSE',&
|
||||
'! This stand alone program is used at build time to generate the header file',&
|
||||
'! H5fort_type_defines.h. The source code itself was automatically generated by',&
|
||||
'! the program H5test_kind.f90',&
|
||||
'!',&
|
||||
'! COPYRIGHT',&
|
||||
'! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *',&
|
||||
'! Copyright by The HDF Group. *',&
|
||||
'! 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. *',&
|
||||
'! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *',&
|
||||
'!',&
|
||||
'! AUTHOR',&
|
||||
'! H5test_kind.f90',&
|
||||
'!',&
|
||||
'!*****'
|
||||
|
||||
! GENERATE A PROGRAM
|
||||
! (a) Generate Fortran H5* interfaces having multiple KIND interfaces.
|
||||
!
|
||||
! (a) Generate the module
|
||||
|
||||
WRITE(*,*) "MODULE H5test_kind_mod"
|
||||
WRITE(*,*) "USE ISO_C_BINDING"
|
||||
WRITE(*,*) "IMPLICIT NONE"
|
||||
WRITE(*,*) "CONTAINS"
|
||||
j = 0
|
||||
ji = KIND(1)
|
||||
WRITE(*, "("" SUBROUTINE i"", i2.2,""()"")") j
|
||||
WRITE(*,*)" IMPLICIT NONE"
|
||||
WRITE(*,*)" INTEGER :: a"
|
||||
WRITE(*,*)" INTEGER(C_SIZE_T) :: a_size"
|
||||
WRITE(*,*)" CHARACTER(LEN=2) :: ichr2, jchr2"
|
||||
#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
|
||||
WRITE(*,*)" a_size = STORAGE_SIZE(a, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)"
|
||||
#else
|
||||
WRITE(*,*)" a_size = SIZEOF(a)"
|
||||
#endif
|
||||
WRITE(*,*)" WRITE(ichr2,'(I2)') a_size"
|
||||
WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ",ji
|
||||
WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_NATIVE_"'// &
|
||||
"//TRIM(ADJUSTL(ichr2))//"//'"_KIND "'//"//ADJUSTL(jchr2)"
|
||||
WRITE(*,*)" RETURN"
|
||||
WRITE(*,*)"END SUBROUTINE"
|
||||
jr = 0
|
||||
j = KIND(1.0)
|
||||
WRITE(*, "("" SUBROUTINE r"", i2.2,""()"")") jr
|
||||
WRITE(*,*)" IMPLICIT NONE"
|
||||
WRITE(*,*)" REAL :: a"
|
||||
WRITE(*,*)" INTEGER(C_SIZE_T) :: a_size"
|
||||
WRITE(*,*)" CHARACTER(LEN=2) :: ichr2, jchr2"
|
||||
#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
|
||||
WRITE(*,*)" a_size = STORAGE_SIZE(a, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)"
|
||||
#else
|
||||
WRITE(*,*)" a_size = SIZEOF(a)"
|
||||
#endif
|
||||
WRITE(*,*)" WRITE(ichr2,'(I2)') a_size"
|
||||
WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ",j
|
||||
WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_REAL_NATIVE_"'// &
|
||||
"//TRIM(ADJUSTL(ichr2))//"//'"_KIND "'//"//ADJUSTL(jchr2)"
|
||||
WRITE(*,*)" RETURN"
|
||||
WRITE(*,*)"END SUBROUTINE"
|
||||
jd = 0
|
||||
j = KIND(1.d0)
|
||||
WRITE(*, "("" SUBROUTINE d"", i2.2,""()"")") jd
|
||||
WRITE(*,*)" IMPLICIT NONE"
|
||||
WRITE(*,*)" DOUBLE PRECISION :: a"
|
||||
WRITE(*,*)" INTEGER(C_SIZE_T) :: a_size"
|
||||
WRITE(*,*)" CHARACTER(LEN=2) :: ichr2, jchr2"
|
||||
#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
|
||||
WRITE(*,*)" a_size = STORAGE_SIZE(a, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)"
|
||||
#else
|
||||
WRITE(*,*)" a_size = SIZEOF(a)"
|
||||
#endif
|
||||
WRITE(*,*)" WRITE(ichr2,'(I2)') a_size"
|
||||
WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ",j
|
||||
WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_DOUBLE_NATIVE_"'// &
|
||||
"//TRIM(ADJUSTL(ichr2))//"//'"_KIND "'//"//ADJUSTL(jchr2)"
|
||||
WRITE(*,*)" RETURN"
|
||||
WRITE(*,*)"END SUBROUTINE"
|
||||
DO i = 1, num_ikinds
|
||||
j = ikind(i)
|
||||
WRITE(*, "("" SUBROUTINE i"", i2.2,""()"")") j
|
||||
WRITE(*,*)" IMPLICIT NONE"
|
||||
WRITE(*,'(A,I0,A)')" INTEGER(KIND=",j,") :: a"
|
||||
WRITE(*,*)" INTEGER(C_SIZE_T) :: a_size"
|
||||
WRITE(*,*)" CHARACTER(LEN=2) :: ichr2, jchr2"
|
||||
#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
|
||||
WRITE(*,*)" a_size = STORAGE_SIZE(a, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)"
|
||||
#else
|
||||
WRITE(*,*)" a_size = SIZEOF(a)"
|
||||
#endif
|
||||
WRITE(*,*)" WRITE(ichr2,'(I2)') a_size"
|
||||
WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ",j
|
||||
WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_INTEGER_"'// &
|
||||
"//TRIM(ADJUSTL(ichr2))//"//'"_KIND "'//"//ADJUSTL(jchr2)"
|
||||
WRITE(*,*)" RETURN"
|
||||
WRITE(*,*)"END SUBROUTINE"
|
||||
ENDDO
|
||||
DO i = 1, num_rkinds
|
||||
j = rkind(i)
|
||||
WRITE(*, "("" SUBROUTINE r"", i2.2,""()"")") j
|
||||
WRITE(*,*)" IMPLICIT NONE"
|
||||
WRITE(*,'(A,I0,A)')" REAL(KIND= ",j,") :: a"
|
||||
WRITE(*,*)" INTEGER(C_SIZE_T) :: a_size"
|
||||
WRITE(*,*)" CHARACTER(LEN=2) :: ichr2, jchr2"
|
||||
#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
|
||||
WRITE(*,*)" a_size = STORAGE_SIZE(a, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)"
|
||||
#else
|
||||
WRITE(*,*)" a_size = SIZEOF(a)"
|
||||
#endif
|
||||
WRITE(*,*)" WRITE(ichr2,'(I2)') a_size"
|
||||
WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", j
|
||||
WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_REAL_"'// &
|
||||
"//TRIM(ADJUSTL(ichr2))//"//'"_KIND "'//"//ADJUSTL(jchr2)"
|
||||
WRITE(*,*)" RETURN"
|
||||
WRITE(*,*)"END SUBROUTINE"
|
||||
ENDDO
|
||||
WRITE(*,*) "END MODULE H5test_kind_mod"
|
||||
WRITE(*,*) ""
|
||||
|
||||
! (b) generate the main program
|
||||
|
||||
WRITE(*,*) "PROGRAM H5test_kind"
|
||||
WRITE(*,*) "USE H5test_kind_mod"
|
||||
WRITE(*,*) "CHARACTER(LEN=2) :: jchr2"
|
||||
WRITE(*,*) "WRITE(*,*) "" /*generated header file*/ """
|
||||
ji = 0
|
||||
WRITE(*, "("" CALL i"", i2.2,""()"")") ji
|
||||
jr = 0
|
||||
WRITE(*, "("" CALL r"", i2.2,""()"")") jr
|
||||
jd = 0
|
||||
WRITE(*, "("" CALL d"", i2.2,""()"")") jd
|
||||
DO i = 1, num_ikinds
|
||||
j = ikind(i)
|
||||
WRITE(*, "("" CALL i"", i2.2,""()"")") j
|
||||
ENDDO
|
||||
DO i = 1, num_rkinds
|
||||
j = rkind(i)
|
||||
WRITE(*, "("" CALL r"", i2.2,""()"")") j
|
||||
ENDDO
|
||||
#ifdef H5_FORTRAN_HAVE_C_LONG_DOUBLE
|
||||
|
||||
# ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
|
||||
sizeof_var = STORAGE_SIZE(c_longdble, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)
|
||||
# else
|
||||
sizeof_var = SIZEOF(c_longdble)
|
||||
# endif
|
||||
|
||||
WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", C_LONG_DOUBLE
|
||||
WRITE(*,'(A)')' WRITE(*,*) "#define C_LONG_DOUBLE_KIND "'//"//ADJUSTL(jchr2)"
|
||||
WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", sizeof_var
|
||||
WRITE(*,'(A)')' WRITE(*,*) "#define C_LONG_DOUBLE_SIZEOF "'//"//ADJUSTL(jchr2)"
|
||||
#else
|
||||
WRITE(*,'(A)')' WRITE(*,*) "#define C_LONG_DOUBLE_KIND -1"'
|
||||
WRITE(*,'(A)')' WRITE(*,*) "#define C_LONG_DOUBLE_SIZEOF -1"'
|
||||
#endif
|
||||
|
||||
#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
|
||||
sizeof_var = STORAGE_SIZE(c_dble, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)
|
||||
#else
|
||||
sizeof_var = SIZEOF(c_dble)
|
||||
#endif
|
||||
WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", C_DOUBLE
|
||||
WRITE(*,'(A)')' WRITE(*,*) "#define C_DOUBLE_KIND "'//"//ADJUSTL(jchr2)"
|
||||
WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", sizeof_var
|
||||
WRITE(*,'(A)')' WRITE(*,*) "#define C_DOUBLE_SIZEOF "'//"//ADJUSTL(jchr2)"
|
||||
|
||||
#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
|
||||
sizeof_var = STORAGE_SIZE(c_flt, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)
|
||||
#else
|
||||
sizeof_var = SIZEOF(c_flt)
|
||||
#endif
|
||||
WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", C_FLOAT
|
||||
WRITE(*,'(A)')' WRITE(*,*) "#define C_FLOAT_KIND "'//"//ADJUSTL(jchr2)"
|
||||
WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", sizeof_var
|
||||
WRITE(*,'(A)')' WRITE(*,*) "#define C_FLOAT_SIZEOF "'//"//ADJUSTL(jchr2)"
|
||||
|
||||
WRITE(*,*) "END PROGRAM H5test_kind"
|
||||
|
||||
10 CONTINUE
|
||||
|
||||
! (c) Generate Fortran H5* interfaces having multiple KIND interfaces.
|
||||
!
|
||||
! Developer's notes:
|
||||
! DEVELOPER'S NOTES:
|
||||
!
|
||||
! Only interfaces with arrays of rank 7 and less are provided. Even-though, the F2008
|
||||
! standard extended the maximum rank to 15, it was decided that they should use the
|
||||
@ -309,7 +110,7 @@ WRITE(*,'(40(A,/))') &
|
||||
'! H5_KIND',&
|
||||
'! ',&
|
||||
'! PURPOSE',&
|
||||
'! This module is generated at build by H5test_kind.F90 to handle all the',&
|
||||
'! This module is generated at build by H5_buildiface.F90 to handle all the',&
|
||||
'! detected REAL KINDs for APIs being passed REAL KINDs. Currently these ',&
|
||||
'! are H5A, H5D and H5P APIs',&
|
||||
'!',&
|
||||
@ -329,7 +130,7 @@ WRITE(*,'(40(A,/))') &
|
||||
'! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *',&
|
||||
'!',&
|
||||
'! AUTHOR',&
|
||||
'! H5test_kind.F90',&
|
||||
'! H5_buildiface.F90',&
|
||||
'!',&
|
||||
'!*****'
|
||||
|
||||
@ -749,6 +550,7 @@ WRITE(*,'(40(A,/))') &
|
||||
CLOSE(11)
|
||||
|
||||
! (b) Generate Fortran Check routines for the tests KIND interfaces.
|
||||
|
||||
OPEN(11,FILE='../test/tf_gen.F90')
|
||||
WRITE(11,'(40(A,/))') &
|
||||
'!****h* ROBODoc/TH5_MISC_gen.F90',&
|
||||
@ -757,7 +559,7 @@ WRITE(*,'(40(A,/))') &
|
||||
'! TH5_MISC_gen',&
|
||||
'! ',&
|
||||
'! PURPOSE',&
|
||||
'! This module is generated at build by H5test_kind.F90 to handle checking ',&
|
||||
'! This module is generated at build by H5_buildiface.F90 to handle checking ',&
|
||||
'! in the tests all the detected KINDs.',&
|
||||
'!',&
|
||||
'! COPYRIGHT',&
|
||||
@ -776,7 +578,7 @@ WRITE(*,'(40(A,/))') &
|
||||
'! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *',&
|
||||
'!',&
|
||||
'! AUTHOR',&
|
||||
'! H5test_kind.F90',&
|
||||
'! H5_buildiface.F90',&
|
||||
'!',&
|
||||
'!*****'
|
||||
|
||||
@ -903,7 +705,7 @@ WRITE(*,'(40(A,/))') &
|
||||
WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)'
|
||||
WRITE(11,'(A)') '!DEC$attributes dllexport :: verify_logical'
|
||||
WRITE(11,'(A)') '!DEC$endif'
|
||||
! Subroutine API
|
||||
! Subroutine API
|
||||
WRITE(11,'(A)') ' SUBROUTINE verify_logical(string,value,correct_value,total_error)'
|
||||
WRITE(11,'(A)') ' CHARACTER(LEN=*) :: string'
|
||||
WRITE(11,'(A)') ' LOGICAL :: value, correct_value'
|
||||
|
||||
Loading…
Reference in New Issue
Block a user