summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2015-07-09 19:54:43 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2015-07-09 19:54:43 (GMT)
commitf71a46a99ca6ab3e5115972b5479f21911c68b50 (patch)
tree62ccbecaa03abf57cb80c9b86e2394deebe46569 /fortran
parent0a8317aab70973ee810330025b5a36969e462d92 (diff)
downloadhdf5-f71a46a99ca6ab3e5115972b5479f21911c68b50.zip
hdf5-f71a46a99ca6ab3e5115972b5479f21911c68b50.tar.gz
hdf5-f71a46a99ca6ab3e5115972b5479f21911c68b50.tar.bz2
[svn-r27366] misc. clean-up
Diffstat (limited to 'fortran')
-rw-r--r--fortran/src/H5_buildiface.F90220
1 files changed, 11 insertions, 209 deletions
diff --git a/fortran/src/H5_buildiface.F90 b/fortran/src/H5_buildiface.F90
index f73f915..4f7f965 100644
--- a/fortran/src/H5_buildiface.F90
+++ b/fortran/src/H5_buildiface.F90
@@ -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 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.
+! (a) 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'