diff options
Diffstat (limited to 'fortran/src/H5test_kind.F90')
| -rw-r--r-- | fortran/src/H5test_kind.F90 | 158 |
1 files changed, 67 insertions, 91 deletions
diff --git a/fortran/src/H5test_kind.F90 b/fortran/src/H5test_kind.F90 index e83139a..f73f915 100644 --- a/fortran/src/H5test_kind.F90 +++ b/fortran/src/H5test_kind.F90 @@ -51,7 +51,15 @@ PROGRAM test_kind USE, INTRINSIC :: ISO_C_BINDING IMPLICIT NONE - INTEGER :: i, j, k, ii, ir, last, ikind_numbers(10), rkind_numbers(10) + +! These values are valid REAL KINDs (with corresponding C float) found during configure + H5_H5CONFIG_F_NUM_RKIND + H5_H5CONFIG_F_RKIND +! These values are valid INTEGER KINDs (with corresponding C float) found during configure + H5_H5CONFIG_F_NUM_IKIND + H5_H5CONFIG_F_IKIND + + INTEGER :: i, j, k INTEGER :: ji, jr, jd #ifdef H5_FORTRAN_HAVE_C_LONG_DOUBLE REAL(KIND=C_LONG_DOUBLE) :: c_longdble @@ -85,38 +93,6 @@ PROGRAM test_kind ' f_ptr = C_LOC(buf(1,1,1,1,1,1,1))' & /) - last = -1 - ii = 0 - - ikind_numbers = 0 - rkind_numbers = 0 - - 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 - GOTO 10 ! Generate program information: @@ -214,8 +190,8 @@ WRITE(*,'(40(A,/))') & "//TRIM(ADJUSTL(ichr2))//"//'"_KIND "'//"//ADJUSTL(jchr2)" WRITE(*,*)" RETURN" WRITE(*,*)"END SUBROUTINE" - DO i = 1, ii - j = ikind_numbers(i) + DO i = 1, num_ikinds + j = ikind(i) WRITE(*, "("" SUBROUTINE i"", i2.2,""()"")") j WRITE(*,*)" IMPLICIT NONE" WRITE(*,'(A,I0,A)')" INTEGER(KIND=",j,") :: a" @@ -233,8 +209,8 @@ WRITE(*,'(40(A,/))') & WRITE(*,*)" RETURN" WRITE(*,*)"END SUBROUTINE" ENDDO - DO i = 1, ir - j = rkind_numbers(i) + DO i = 1, num_rkinds + j = rkind(i) WRITE(*, "("" SUBROUTINE r"", i2.2,""()"")") j WRITE(*,*)" IMPLICIT NONE" WRITE(*,'(A,I0,A)')" REAL(KIND= ",j,") :: a" @@ -267,12 +243,12 @@ WRITE(*,'(40(A,/))') & WRITE(*, "("" CALL r"", i2.2,""()"")") jr jd = 0 WRITE(*, "("" CALL d"", i2.2,""()"")") jd - DO i = 1, ii - j = ikind_numbers(i) + DO i = 1, num_ikinds + j = ikind(i) WRITE(*, "("" CALL i"", i2.2,""()"")") j ENDDO - DO i = 1, ir - j = rkind_numbers(i) + DO i = 1, num_rkinds + j = rkind(i) WRITE(*, "("" CALL r"", i2.2,""()"")") j ENDDO #ifdef H5_FORTRAN_HAVE_C_LONG_DOUBLE @@ -373,8 +349,8 @@ WRITE(*,'(40(A,/))') & ! H5Awrite_f ! WRITE(11,'(A)') " INTERFACE h5awrite_f" - DO i = 1, ir - j = rkind_numbers(i) + DO i = 1, num_rkinds + j = rkind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 WRITE(11,'(A)') " MODULE PROCEDURE h5awrite_kind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) @@ -384,8 +360,8 @@ WRITE(*,'(40(A,/))') & ! H5Aread_f WRITE(11,'(A)') " INTERFACE h5aread_f" - DO i = 1, ir - j = rkind_numbers(i) + DO i = 1, num_rkinds + j = rkind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 WRITE(11,'(A)') " MODULE PROCEDURE h5aread_kind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) @@ -398,8 +374,8 @@ WRITE(*,'(40(A,/))') & ! ! H5Dwrite_f WRITE(11,'(A)') " INTERFACE h5dwrite_f" - DO i = 1, ir - j = rkind_numbers(i) + DO i = 1, num_rkinds + j = rkind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 WRITE(11,'(A)') " MODULE PROCEDURE h5dwrite_kind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) @@ -409,8 +385,8 @@ WRITE(*,'(40(A,/))') & ! H5Dread_f WRITE(11,'(A)') " INTERFACE h5dread_f" - DO i = 1, ir - j = rkind_numbers(i) + DO i = 1, num_rkinds + j = rkind(i) WRITE(chr2,'(I2)') j DO k = 1, 8 WRITE(11,'(A)') " MODULE PROCEDURE h5dread_kind_"//TRIM(ADJUSTL(chr2))//'_rank'//chr_rank(k) @@ -424,8 +400,8 @@ WRITE(*,'(40(A,/))') & ! ! H5Pset_fill_value_f WRITE(11,'(A)') " INTERFACE h5pset_fill_value_f" - DO i = 1, ir - j = rkind_numbers(i) + DO i = 1, num_rkinds + j = rkind(i) WRITE(chr2,'(I2)') j WRITE(11,'(A)') " MODULE PROCEDURE h5pset_fill_value_kind_"//TRIM(ADJUSTL(chr2)) END DO @@ -433,8 +409,8 @@ WRITE(*,'(40(A,/))') & ! H5Pget_fill_value_f WRITE(11,'(A)') " INTERFACE h5pget_fill_value_f" - DO i = 1, ir - j = rkind_numbers(i) + DO i = 1, num_rkinds + j = rkind(i) WRITE(chr2,'(I2)') j WRITE(11,'(A)') " MODULE PROCEDURE h5pget_fill_value_kind_"//TRIM(ADJUSTL(chr2)) END DO @@ -442,8 +418,8 @@ WRITE(*,'(40(A,/))') & ! H5Pset_f WRITE(11,'(A)') " INTERFACE h5pset_f" - DO i = 1, ir - j = rkind_numbers(i) + DO i = 1, num_rkinds + j = rkind(i) WRITE(chr2,'(I2)') j WRITE(11,'(A)') " MODULE PROCEDURE h5pset_kind_"//TRIM(ADJUSTL(chr2)) END DO @@ -451,8 +427,8 @@ WRITE(*,'(40(A,/))') & ! H5Pget_f WRITE(11,'(A)') " INTERFACE h5pget_f" - DO i = 1, ir - j = rkind_numbers(i) + DO i = 1, num_rkinds + j = rkind(i) WRITE(chr2,'(I2)') j WRITE(11,'(A)') " MODULE PROCEDURE h5pget_kind_"//TRIM(ADJUSTL(chr2)) END DO @@ -460,8 +436,8 @@ WRITE(*,'(40(A,/))') & ! H5Pregister_f WRITE(11,'(A)') " INTERFACE h5pregister_f" - DO i = 1, ir - j = rkind_numbers(i) + DO i = 1, num_rkinds + j = rkind(i) WRITE(chr2,'(I2)') j WRITE(11,'(A)') " MODULE PROCEDURE h5pregister_kind_"//TRIM(ADJUSTL(chr2)) END DO @@ -469,8 +445,8 @@ WRITE(*,'(40(A,/))') & ! H5Pinsert_f WRITE(11,'(A)') " INTERFACE h5pinsert_f" - DO i = 1, ir - j = rkind_numbers(i) + DO i = 1, num_rkinds + j = rkind(i) WRITE(chr2,'(I2)') j WRITE(11,'(A)') " MODULE PROCEDURE h5pinsert_kind_"//TRIM(ADJUSTL(chr2)) END DO @@ -483,8 +459,8 @@ WRITE(*,'(40(A,/))') & !********************** ! ! H5Awrite_f - DO i = 1, ir - k = rkind_numbers(i) + DO i = 1, num_rkinds + k = rkind(i) WRITE(chr2,'(I2)') k DO j = 1, 8 @@ -511,8 +487,8 @@ WRITE(*,'(40(A,/))') & ENDDO ! ! H5Aread_f - DO i = 1, ir - k = rkind_numbers(i) + DO i = 1, num_rkinds + k = rkind(i) WRITE(chr2,'(I2)') k DO j = 1, 8 ! DLL definitions for windows @@ -541,8 +517,8 @@ WRITE(*,'(40(A,/))') & !********************** ! ! h5dread_f - DO i = 1, ir - k = rkind_numbers(i) + DO i = 1, num_rkinds + k = rkind(i) WRITE(chr2,'(I2)') k DO j = 1, 8 ! DLL definitions for windows @@ -582,8 +558,8 @@ WRITE(*,'(40(A,/))') & ENDDO ! ! h5dwrite_f - DO i = 1, ir - k = rkind_numbers(i) + DO i = 1, num_rkinds + k = rkind(i) WRITE(chr2,'(I2)') k DO j = 1, 8 ! DLL definitions for windows @@ -626,8 +602,8 @@ WRITE(*,'(40(A,/))') & !********************** ! ! H5Pset_fill_value_f - DO i = 1, ir - k = rkind_numbers(i) + DO i = 1, num_rkinds + k = rkind(i) WRITE(chr2,'(I2)') k ! DLL definitions for windows WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_DLL)' @@ -648,8 +624,8 @@ WRITE(*,'(40(A,/))') & ENDDO ! H5Pget_fill_value_f - DO i = 1, ir - k = rkind_numbers(i) + DO i = 1, num_rkinds + k = rkind(i) WRITE(chr2,'(I2)') k ! DLL definitions for windows WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_DLL)' @@ -670,8 +646,8 @@ WRITE(*,'(40(A,/))') & ENDDO ! H5Pset_f - DO i = 1, ir - k = rkind_numbers(i) + DO i = 1, num_rkinds + k = rkind(i) WRITE(chr2,'(I2)') k ! DLL definitions for windows WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_DLL)' @@ -695,8 +671,8 @@ WRITE(*,'(40(A,/))') & ENDDO ! H5Pget_f - DO i = 1, ir - k = rkind_numbers(i) + DO i = 1, num_rkinds + k = rkind(i) WRITE(chr2,'(I2)') k ! DLL definitions for windows WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_DLL)' @@ -719,8 +695,8 @@ WRITE(*,'(40(A,/))') & ENDDO ! H5Pregister_f - DO i = 1, ir - k = rkind_numbers(i) + DO i = 1, num_rkinds + k = rkind(i) WRITE(chr2,'(I2)') k ! DLL definitions for windows WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_DLL)' @@ -744,8 +720,8 @@ WRITE(*,'(40(A,/))') & ENDDO ! H5Pinsert_f - DO i = 1, ir - k = rkind_numbers(i) + DO i = 1, num_rkinds + k = rkind(i) WRITE(chr2,'(I2)') k ! DLL definitions for windows WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_DLL)' @@ -812,13 +788,13 @@ WRITE(*,'(40(A,/))') & ! Interfaces for validating REALs, INTEGERs, CHARACTERs, LOGICALs WRITE(11,'(A)') ' INTERFACE verify' - DO i = 1, ir - j = rkind_numbers(i) + DO i = 1, num_rkinds + j = rkind(i) WRITE(chr2,'(I2)') j WRITE(11,'(A)') " MODULE PROCEDURE verify_real_kind_"//TRIM(ADJUSTL(chr2)) END DO - DO i = 1, ii - j = ikind_numbers(i) + DO i = 1, num_ikinds + j = ikind(i) WRITE(chr2,'(I2)') j WRITE(11,'(A)') " MODULE PROCEDURE verify_integer_kind_"//TRIM(ADJUSTL(chr2)) END DO @@ -827,8 +803,8 @@ WRITE(*,'(40(A,/))') & WRITE(11,'(A)') " END INTERFACE" WRITE(11,'(A)') ' INTERFACE check_real_eq' - DO i = 1, ir - j = rkind_numbers(i) + DO i = 1, num_rkinds + j = rkind(i) WRITE(chr2,'(I2)') j WRITE(11,'(A)') " MODULE PROCEDURE real_eq_kind_"//TRIM(ADJUSTL(chr2)) END DO @@ -839,8 +815,8 @@ WRITE(*,'(40(A,/))') & ! *************************** ! VALIDATE INTEGERS ! *************************** - DO i = 1, ii - k = ikind_numbers(i) + DO i = 1, num_ikinds + k = ikind(i) WRITE(chr2,'(I2)') k ! DLL definitions for windows WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)' @@ -863,8 +839,8 @@ WRITE(*,'(40(A,/))') & ! *************************** ! VALIDATE REALS ! *************************** - DO i = 1, ir - k = rkind_numbers(i) + DO i = 1, num_rkinds + k = rkind(i) WRITE(chr2,'(I2)') k ! DLL definitions for windows WRITE(11,'(A)') '!DEC$if defined(BUILD_HDF5_TEST_DLL)' |