summaryrefslogtreecommitdiffstats
path: root/fortran/src
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2008-09-01 15:36:29 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2008-09-01 15:36:29 (GMT)
commita3f1ca5e7dc56d0d5cf572f074b77ee1be74c889 (patch)
tree100074becb7633f4f0992f52b6d92ef02c8c655c /fortran/src
parent97757e7217530f7e8a2abfb00b5bdb301ef0709d (diff)
downloadhdf5-a3f1ca5e7dc56d0d5cf572f074b77ee1be74c889.zip
hdf5-a3f1ca5e7dc56d0d5cf572f074b77ee1be74c889.tar.gz
hdf5-a3f1ca5e7dc56d0d5cf572f074b77ee1be74c889.tar.bz2
[svn-r15572] Desciption:
Was not returning the correct fortran types when -i8 and -r8 flag was specified, fixed. This code is now depreciated and only used when SIZEOF function is not available, H5test_kind_SIZEOF.f90 should be used instead.
Diffstat (limited to 'fortran/src')
-rw-r--r--fortran/src/H5test_kind.f90242
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
+