diff options
author | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2015-07-09 19:54:43 (GMT) |
---|---|---|
committer | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2015-07-09 19:54:43 (GMT) |
commit | f71a46a99ca6ab3e5115972b5479f21911c68b50 (patch) | |
tree | 62ccbecaa03abf57cb80c9b86e2394deebe46569 /fortran | |
parent | 0a8317aab70973ee810330025b5a36969e462d92 (diff) | |
download | hdf5-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.F90 | 220 |
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' |