diff options
Diffstat (limited to 'fortran/src/H5test_kind.f90')
| -rw-r--r-- | fortran/src/H5test_kind.f90 | 269 |
1 files changed, 0 insertions, 269 deletions
diff --git a/fortran/src/H5test_kind.f90 b/fortran/src/H5test_kind.f90 deleted file mode 100644 index 1a1a0ec..0000000 --- a/fortran/src/H5test_kind.f90 +++ /dev/null @@ -1,269 +0,0 @@ -!****p* Program/H5test_kind -! -! NAME -! Executable: H5test_kind -! -! FILE -! fortran/src/H5test_kind.f90 -! -! PURPOSE -! This stand alone program is used at build time to generate the program -! H5fortran_detect.f90. It cycles through all the available KIND parameters for -! integers and reals. The appropriate program and subroutines are then generated -! depending on which of the KIND values are found. -! -! NOTES -! This program is depreciated in favor of H5test_kind_SIZEOF.f90 and is only -! used when the Fortran intrinsic function SIZEOF is not available. It generates -! code that does not make use of SIZEOF in H5fortran_detect.f90 which is less -! portable in comparison to using SIZEOF. -! -! The availability of SIZEOF is checked at configure time and the TRUE/FALSE -! condition is set in the configure variable "FORTRAN_HAVE_SIZEOF". -! -! COPYRIGHT -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! Copyright by The HDF Group. * -! 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://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 -! Elena Pourma -! -!***** - -PROGRAM test_kind - IMPLICIT NONE - INTEGER :: i, j, ii, ir, last, ikind_numbers(10), rkind_numbers(10) - INTEGER :: ji, 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 - ikind_numbers(ii) = last - ENDIF - last = j - IF(j .EQ. -1) EXIT - ENDIF - ENDDO - - last = -1 - ir = 0 - DO i = 1,100 - j = SELECTED_REAL_KIND(i) - IF(j .NE. last) THEN - IF(last .NE. -1) THEN - ir = ir + 1 - rkind_numbers(ir) = last - ENDIF - last = j - IF(j .EQ. -1) EXIT - ENDIF - ENDDO - -! 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',& -'!',& -'! NOTES',& -'! This source code does not make use of the Fortran intrinsic function SIZEOF because',& -'! the availability of the intrinsic function was determined to be not available at',& -'! configure time',& -'!',& -'! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *',& -'! Copyright by The HDF Group. *',& -'! 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://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 - - WRITE(*,*) "PROGRAM int_kind" - WRITE(*,*) "WRITE(*,*) "" /*generating 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, ii - j = ikind_numbers(i) - WRITE(*, "("" CALL i"", i2.2,""()"")") j - ENDDO - DO i = 1, ir - j = rkind_numbers(i) - WRITE(*, "("" CALL r"", i2.2,""()"")") j - ENDDO - WRITE(*,*) "END PROGRAM int_kind" - j = 0 - ji = KIND(1) - WRITE(*, "("" SUBROUTINE i"", i2.2,""()"")") j - WRITE(*,*)" IMPLICIT NONE" - WRITE(*,*)" INTEGER :: a = 0" - WRITE(*,*)" INTEGER :: a_size" - WRITE(*,*)" CHARACTER(LEN=2) :: jchr2" - WRITE(*,*)" a_size = BIT_SIZE(a)" - WRITE(*,*)" IF (a_size .EQ. 8) THEN" - WRITE(*,*)" WRITE(jchr2,'(I2)')",ji - WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_NATIVE_1_KIND "'//"//ADJUSTL(jchr2)" - WRITE(*,*)" endif" - WRITE(*,*)" IF (a_size .EQ. 16) THEN" - WRITE(*,*)" WRITE(jchr2,'(I2)')",ji - WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_NATIVE_2_KIND "'//"//ADJUSTL(jchr2)" - WRITE(*,*)" endif" - WRITE(*,*)" IF (a_size .EQ. 32) THEN" - WRITE(*,*)" WRITE(jchr2,'(I2)')",ji - WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_NATIVE_4_KIND "'//"//ADJUSTL(jchr2)" - WRITE(*,*)" ENDIF" - WRITE(*,*)" IF (a_size .EQ. 64) THEN" - WRITE(*,*)" WRITE(jchr2,'(I2)')",ji - WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_NATIVE_8_KIND "'//"//ADJUSTL(jchr2)" - WRITE(*,*)" ENDIF" - WRITE(*,*)" IF (a_size .EQ. 128) THEN" - WRITE(*,*)" WRITE(jchr2,'(I2)')",ji - WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_NATIVE_16_KIND "'//"//ADJUSTL(jchr2)" - WRITE(*,*)" ENDIF" - WRITE(*,*)" RETURN" - WRITE(*,*)"END SUBROUTINE" - jr = KIND(1.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(*,*)" CHARACTER(LEN=2) :: jchr2" - 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(jchr2,'(I2)')",jr - WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_REAL_NATIVE_4_KIND "'//"//ADJUSTL(jchr2)" - WRITE(*,*)" ENDIF" - WRITE(*,*)" IF (real_size .EQ. 64) THEN" - WRITE(*,*)" WRITE(jchr2,'(I2)')",jr - WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_REAL_NATIVE_8_KIND "'//"//ADJUSTL(jchr2)" - WRITE(*,*)" ENDIF" - WRITE(*,*)" IF (real_size .EQ. 128) THEN" - WRITE(*,*)" WRITE(jchr2,'(I2)')",jr - WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_REAL_NATIVE_16_KIND "'//"//ADJUSTL(jchr2)" - WRITE(*,*)" ENDIF" - WRITE(*,*)" RETURN" - WRITE(*,*)"END SUBROUTINE" - jd = KIND(1.d0) - WRITE(*, "("" SUBROUTINE d"", i2.2,""()"")") j - WRITE(*,*)" IMPLICIT NONE" - WRITE(*,*)" DOUBLE PRECISION :: b=0" - WRITE(*,*)" INTEGER :: a(8)=0" - WRITE(*,*)" INTEGER :: a_size" - WRITE(*,*)" INTEGER :: b_size" - WRITE(*,*)" CHARACTER(LEN=2) :: jchr2" - 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(jchr2,'(I2)')",jd - WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_DOUBLE_NATIVE_8_KIND "'//"//ADJUSTL(jchr2)" - WRITE(*,*)" ENDIF" - WRITE(*,*)" IF (b_size .EQ. 128) THEN" - WRITE(*,*)" WRITE(jchr2,'(I2)')",jd - WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_DOUBLE_NATIVE_16_KIND "'//"//ADJUSTL(jchr2)" - WRITE(*,*)" ENDIF" - WRITE(*,*)" RETURN" - WRITE(*,*)"END SUBROUTINE" - DO i = 1, ii - j = ikind_numbers(i) - WRITE(*, "("" SUBROUTINE i"", i2.2,""()"")") j - WRITE(*,*)" IMPLICIT NONE" - WRITE(*,*)" INTEGER(",j,") :: a = 0" - WRITE(*,*)" INTEGER :: a_size" - WRITE(*,*)" CHARACTER(LEN=2) :: jchr2" - WRITE(*,*)" a_size = BIT_SIZE(a)" - WRITE(*,*)" IF (a_size .EQ. 8) THEN" - WRITE(*,*)" WRITE(jchr2,'(I2)')",j - WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_INTEGER_1_KIND "'//"//ADJUSTL(jchr2)" - WRITE(*,*)" ENDIF" - WRITE(*,*)" IF (a_size .EQ. 16) THEN" - WRITE(*,*)" WRITE(jchr2,'(I2)')",j - WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_INTEGER_2_KIND "'//"//ADJUSTL(jchr2)" - WRITE(*,*)" ENDIF" - WRITE(*,*)" IF (a_size .EQ. 32) THEN" - WRITE(*,*)" WRITE(jchr2,'(I2)')",j - WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_INTEGER_4_KIND "'//"//ADJUSTL(jchr2)" - WRITE(*,*)" ENDIF" - WRITE(*,*)" IF (a_size .EQ. 64) THEN" - WRITE(*,*)" WRITE(jchr2,'(I2)')",j - WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_INTEGER_8_KIND "'//"//ADJUSTL(jchr2)" - WRITE(*,*)" ENDIF" - WRITE(*,*)" IF (a_size .EQ. 128) THEN" - WRITE(*,*)" WRITE(jchr2,'(I2)')",j - WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_INTEGER_16_KIND "'//"//ADJUSTL(jchr2)" - WRITE(*,*)" ENDIF" - WRITE(*,*)" RETURN" - WRITE(*,*)" END SUBROUTINE" - ENDDO - DO i = 1, ir - j = rkind_numbers(i) - WRITE(*, "("" SUBROUTINE r"", i2.2,""()"")") j - WRITE(*,*)" IMPLICIT NONE" - WRITE(*,*)" REAL(KIND=",j,") :: b(32)" - WRITE(*,*)" INTEGER :: a(1)" - WRITE(*,*)" INTEGER :: a_size" - WRITE(*,*)" INTEGER :: real_size" - WRITE(*,*)" CHARACTER(LEN=2) :: jchr2" - 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(jchr2,'(I2)')",j - WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_REAL_4_KIND "'//"//ADJUSTL(jchr2)" - WRITE(*,*)" ENDIF" - WRITE(*,*)" IF (real_size .EQ. 64) THEN" - WRITE(*,*)" WRITE(jchr2,'(I2)')",j - WRITE(*,*)' WRITE(*,*) "#define H5_FORTRAN_HAS_REAL_8_KIND "'//"//ADJUSTL(jchr2)" - WRITE(*,*)" endif" - WRITE(*,*)" IF (real_size .EQ. 128) THEN" - WRITE(*,*)" WRITE(jchr2,'(I2)')",j - WRITE(*,'(A)')' WRITE(*,*) "#define H5_FORTRAN_HAS_REAL_16_KIND "'//"//ADJUSTL(jchr2)" - WRITE(*,*)" ENDIF" - WRITE(*,*)" RETURN" - WRITE(*,*)" END SUBROUTINE" - ENDDO -END PROGRAM test_kind - - - |