diff options
| -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..5849701 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(*,*)" REAL :: b(32)" + WRITE(*,*)" INTEGER :: a(1)" + WRITE(*,*)" INTEGER :: a_size" + WRITE(*,*)" INTEGER :: double_size" + WRITE(*,*)" a_size = BIT_SIZE(a(1)) ! Size in bits for integer" + WRITE(*,*)" double_size = (SIZE(TRANSFER(b,a))*a_size)/SIZE(b)" + WRITE(*,*)" IF (double_size .EQ. 64) THEN" + WRITE(*,*)" WRITE(*,*) ""#define H5_FORTRAN_HAS_DOUBLE_NATIVE_8"" " + WRITE(*,*)" ENDIF" + WRITE(*,*)" IF (double_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 + |