! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! Copyright by the Board of Trustees of the University of Illinois. * ! 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://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have * ! access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. * ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ! ! H5test_kind.f90 ! ! 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) ! 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" 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" write(*,*)" integer :: a(8)" 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. 32) then" write(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_REAL_NATIVE_4"" " write(*,*)" endif" write(*,*)" if (b_size .eq. 64) then" write(*,*)" write(*,*) ""#define H5_FORTRAN_HAS_REAL_NATIVE_8"" " write(*,*)" endif" write(*,*)" if (b_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" write(*,*)" integer :: a(8)" 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" 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