diff options
author | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2008-09-30 16:42:10 (GMT) |
---|---|---|
committer | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2008-09-30 16:42:10 (GMT) |
commit | fe1ca64d1672af7859c38c143b77533a14c518ec (patch) | |
tree | bbee085742020b59a4b6136f277c6dd4a0bc8de0 /fortran/src/H5test_kind.f90 | |
parent | f361635ae5f344bc80aade6432e80bcf1647522b (diff) | |
download | hdf5-fe1ca64d1672af7859c38c143b77533a14c518ec.zip hdf5-fe1ca64d1672af7859c38c143b77533a14c518ec.tar.gz hdf5-fe1ca64d1672af7859c38c143b77533a14c518ec.tar.bz2 |
[svn-r15727]
Maintenance: Merged new Fortran Features and tests from trunk into hdf5_1_8 branch
(used svn merge -r 14941:14525 http://svn.hdfgroup.uiuc.edu/hdf5/trunk/fortran
command).
Diffstat (limited to 'fortran/src/H5test_kind.f90')
-rw-r--r-- | fortran/src/H5test_kind.f90 | 242 |
1 files changed, 117 insertions, 125 deletions
diff --git a/fortran/src/H5test_kind.f90 b/fortran/src/H5test_kind.f90 index db7178e..e357fea 100644 --- a/fortran/src/H5test_kind.f90 +++ b/fortran/src/H5test_kind.f90 @@ -17,131 +17,123 @@ ! This fortran program generates H5fortran_detect.f90 ! ! - PROGRAM test_kind - INTEGER :: i, j, ii, last, kind_numbers(10) - INTEGER :: jr, jd - last = -1 - ii = 0 - j = SELECTED_INT_KIND(18) -! write(*,*) j - DO i = 1,100 - j = SELECTED_INT_KIND(i) - IF(j .NE. last) THEN - IF(last .NE. -1) THEN - ii = ii + 1 - kind_numbers(ii) = last - ENDIF - last = j - IF(j .EQ. -1) EXIT - ENDIF - ENDDO -! write(*,*) kind_numbers(1:ii) +PROGRAM test_kind + INTEGER :: i, j, ii, last, kind_numbers(10) + INTEGER :: jr, jd + last = -1 + ii = 0 + j = SELECTED_INT_KIND(18) + DO i = 1,100 + j = SELECTED_INT_KIND(i) + IF(j .NE. last) THEN + IF(last .NE. -1) THEN + ii = ii + 1 + kind_numbers(ii) = last + ENDIF + last = j + IF(j .EQ. -1) EXIT + ENDIF + ENDDO ! Generate a program - WRITE(*,*) "program int_kind" - WRITE(*,*) "write(*,*) "" /*generating header file*/ """ - j = 0 - WRITE(*, "("" call i"", i2.2,""()"")") j - jr = 0 - WRITE(*, "("" call r"", i2.2,""()"")") jr - jd = 0 - WRITE(*, "("" call d"", i2.2,""()"")") jd - DO i = 1, ii - j = kind_numbers(i) - WRITE(*, "("" call i"", i2.2,""()"")") j - ENDDO - WRITE(*,*) "end program int_kind" - j = 0 - WRITE(*, "("" subroutine i"", i2.2,""()"")") j - WRITE(*,*)" implicit none" - WRITE(*,*)" integer :: a = 0" - WRITE(*,*)" integer :: a_size" - WRITE(*,*)" a_size = bit_size(a)" - WRITE(*,*)" if (a_size .eq. 8) then" - WRITE(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_NATIVE_1"" " - WRITE(*,*)" endif" - WRITE(*,*)" if (a_size .eq. 16) then" - WRITE(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_NATIVE_2"" " - WRITE(*,*)" endif" - WRITE(*,*)" if (a_size .eq. 32) then" - WRITE(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_NATIVE_4"" " - WRITE(*,*)" endif" - WRITE(*,*)" if (a_size .eq. 64) then" - WRITE(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_NATIVE_8"" " - WRITE(*,*)" endif" - WRITE(*,*)" if (a_size .eq. 128) then" - WRITE(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_NATIVE_16"" " - WRITE(*,*)" endif" - WRITE(*,*)" return" - WRITE(*,*)" end subroutine" - jr = 0 - WRITE(*, "("" subroutine r"", i2.2,""()"")") j - WRITE(*,*)" implicit none" - WRITE(*,*)" real :: b(1) = 0" - WRITE(*,*)" integer :: a(1) = 0" - WRITE(*,*)" integer :: a_size" - WRITE(*,*)" integer :: real_size" - WRITE(*,*)" integer :: ab_size ! How many integers needed to hold a real" - WRITE(*,*)" integer :: ba_size ! How many reals needed to hold an integer" - WRITE(*,*)" a_size = bit_size(a(1)) ! Size in bits for integer" - WRITE(*,*)" ab_size = size(transfer(b,a))" - WRITE(*,*)" ba_size = size(transfer(a,b))" - WRITE(*,*)" if (ab_size .eq. ba_size) real_size=a_size" - WRITE(*,*)" if (ab_size .gt. ba_size) real_size=a_size*ba_size" - WRITE(*,*)" if (ab_size .lt. ba_size) real_size=a_size/ba_size" - WRITE(*,*)" if (real_size .eq. 32) then" - WRITE(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_REAL_NATIVE_4"" " - WRITE(*,*)" endif" - WRITE(*,*)" if (real_size .eq. 64) then" - WRITE(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_REAL_NATIVE_8"" " - WRITE(*,*)" endif" - WRITE(*,*)" if (real_size .eq. 128) then" - WRITE(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_REAL_NATIVE_16"" " - WRITE(*,*)" endif" - WRITE(*,*)" return" - WRITE(*,*)" end subroutine" - jd = 0 - WRITE(*, "("" subroutine d"", i2.2,""()"")") jd - WRITE(*,*)" implicit none" - WRITE(*,*)" double precision :: b = 0" - WRITE(*,*)" integer :: a(8) = 0" - WRITE(*,*)" integer :: a_size" - WRITE(*,*)" integer :: b_size" - WRITE(*,*)" a_size = bit_size(a(1))" - WRITE(*,*)" b_size = size(transfer(b,a))*a_size" - WRITE(*,*)" if (b_size .eq. 64) then" - WRITE(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_DOUBLE_NATIVE_8"" " - WRITE(*,*)" endif" - WRITE(*,*)" if (b_size .eq. 128) then" - WRITE(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_DOUBLE_NATIVE_16"" " - WRITE(*,*)" endif" - WRITE(*,*)" return" - WRITE(*,*)" end subroutine" - DO i = 1, ii - j = kind_numbers(i) - WRITE(*, "("" subroutine i"", i2.2,""()"")") j - WRITE(*,*)" implicit none" - WRITE(*,*)" integer(",j,") :: a = 0" - WRITE(*,*)" integer :: a_size" - WRITE(*,*)" a_size = bit_size(a)" - WRITE(*,*)" if (a_size .eq. 8) then" - WRITE(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_INTEGER_1"" " - WRITE(*,*)" endif" - WRITE(*,*)" if (a_size .eq. 16) then" - WRITE(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_INTEGER_2"" " - WRITE(*,*)" endif" - WRITE(*,*)" if (a_size .eq. 32) then" - WRITE(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_INTEGER_4"" " - WRITE(*,*)" endif" - WRITE(*,*)" if (a_size .eq. 64) then" - WRITE(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_INTEGER_8"" " - WRITE(*,*)" endif" - WRITE(*,*)" if (a_size .eq. 128) then" - WRITE(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_INTEGER_16"" " - WRITE(*,*)" endif" - WRITE(*,*)" return" - WRITE(*,*)" end subroutine" - ENDDO - END PROGRAM - + WRITE(*,*) "PROGRAM int_kind" + WRITE(*,*) "WRITE(*,*) "" /*generating header file*/ """ + j = 0 + WRITE(*, "("" CALL i"", i2.2,""()"")") j + jr = 0 + WRITE(*, "("" CALL r"", i2.2,""()"")") jr + jd = 0 + WRITE(*, "("" CALL d"", i2.2,""()"")") jd + DO i = 1, ii + j = kind_numbers(i) + WRITE(*, "("" CALL i"", i2.2,""()"")") j + ENDDO + WRITE(*,*) "END PROGRAM int_kind" + j = 0 + WRITE(*, "("" SUBROUTINE i"", i2.2,""()"")") j + WRITE(*,*)" IMPLICIT NONE" + WRITE(*,*)" INTEGER :: a = 0" + WRITE(*,*)" INTEGER :: a_size" + WRITE(*,*)" a_size = BIT_SIZE(a)" + WRITE(*,*)" IF (a_size .EQ. 8) THEN" + WRITE(*,*)" WRITE(*,*) ""#define H5_FORTRAN_HAS_NATIVE_1"" " + WRITE(*,*)" endif" + WRITE(*,*)" IF (a_size .EQ. 16) THEN" + WRITE(*,*)" WRITE(*,*) ""#define H5_FORTRAN_HAS_NATIVE_2"" " + WRITE(*,*)" endif" + WRITE(*,*)" IF (a_size .EQ. 32) THEN" + WRITE(*,*)" WRITE(*,*) ""#define H5_FORTRAN_HAS_NATIVE_4"" " + WRITE(*,*)" ENDIF" + WRITE(*,*)" IF (a_size .EQ. 64) THEN" + WRITE(*,*)" WRITE(*,*) ""#define H5_FORTRAN_HAS_NATIVE_8"" " + WRITE(*,*)" ENDIF" + WRITE(*,*)" IF (a_size .EQ. 128) THEN" + WRITE(*,*)" WRITE(*,*) ""#define H5_FORTRAN_HAS_NATIVE_16"" " + WRITE(*,*)" ENDIF" + WRITE(*,*)" RETURN" + WRITE(*,*)"END SUBROUTINE" + jr = 0 + WRITE(*, "("" SUBROUTINE r"", i2.2,""()"")") j + WRITE(*,*)" IMPLICIT NONE" + WRITE(*,*)" REAL :: b(32)" + WRITE(*,*)" INTEGER :: a(1)" + WRITE(*,*)" INTEGER :: a_size" + WRITE(*,*)" INTEGER :: real_size" + WRITE(*,*)" a_size = BIT_SIZE(a(1)) ! Size in bits for integer" + WRITE(*,*)" real_size = (SIZE(TRANSFER(b,a))*a_size)/SIZE(b)" + WRITE(*,*)" IF (real_size .EQ. 32) THEN" + WRITE(*,*)" WRITE(*,*) ""#define H5_FORTRAN_HAS_REAL_NATIVE_4"" " + WRITE(*,*)" ENDIF" + WRITE(*,*)" IF (real_size .EQ. 64) THEN" + WRITE(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_REAL_NATIVE_8"" " + WRITE(*,*)" endif" + WRITE(*,*)" IF (real_size .EQ. 128) THEN" + WRITE(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_REAL_NATIVE_16"" " + WRITE(*,*)" ENDIF" + WRITE(*,*)" RETURN" + WRITE(*,*)"END SUBROUTINE" + jd = 0 + WRITE(*, "("" SUBROUTINE d"", i2.2,""()"")") jd + WRITE(*,*)" IMPLICIT NONE" + WRITE(*,*)" DOUBLE PRECISION :: b=0" + WRITE(*,*)" INTEGER :: a(8)=0" + WRITE(*,*)" INTEGER :: a_size" + WRITE(*,*)" INTEGER :: b_size" + WRITE(*,*)" a_size = BIT_SIZE(a(1))" + WRITE(*,*)" b_size = SIZE(transfer(b,a))*a_size" + WRITE(*,*)" IF (b_size .EQ. 64) THEN" + WRITE(*,*)" WRITE(*,*) ""#define H5_FORTRAN_HAS_DOUBLE_NATIVE_8"" " + WRITE(*,*)" ENDIF" + WRITE(*,*)" IF (b_size .EQ. 128) THEN" + WRITE(*,*)" WRITE(*,*) ""#define H5_FORTRAN_HAS_DOUBLE_NATIVE_16"" " + WRITE(*,*)" ENDIF" + WRITE(*,*)" RETURN" + WRITE(*,*)"END SUBROUTINE" + DO i = 1, ii + j = kind_numbers(i) + WRITE(*, "("" SUBROUTINE i"", i2.2,""()"")") j + WRITE(*,*)" IMPLICIT NONE" + WRITE(*,*)" INTEGER(",j,") :: a = 0" + WRITE(*,*)" INTEGER :: a_size" + WRITE(*,*)" a_size = BIT_SIZE(a)" + WRITE(*,*)" IF (a_size .EQ. 8) THEN" + WRITE(*,*)" WRITE(*,*) ""#define H5_FORTRAN_HAS_INTEGER_1"" " + WRITE(*,*)" ENDIF" + WRITE(*,*)" IF (a_size .EQ. 16) THEN" + WRITE(*,*)" WRITE(*,*) ""#define H5_FORTRAN_HAS_INTEGER_2"" " + WRITE(*,*)" ENDIF" + WRITE(*,*)" IF (a_size .EQ. 32) THEN" + WRITE(*,*)" WRITE(*,*) ""#define H5_FORTRAN_HAS_INTEGER_4"" " + WRITE(*,*)" ENDIF" + WRITE(*,*)" IF (a_size .EQ. 64) THEN" + WRITE(*,*)" WRITE(*,*) ""#define H5_FORTRAN_HAS_INTEGER_8"" " + WRITE(*,*)" ENDIF" + WRITE(*,*)" IF (a_size .EQ. 128) THEN" + WRITE(*,*)" WRITE(*,*) ""#define H5_FORTRAN_HAS_INTEGER_16"" " + WRITE(*,*)" ENDIF" + WRITE(*,*)" RETURN" + WRITE(*,*)" END SUBROUTINE" + ENDDO +END PROGRAM test_kind + |