Skip to content

Commit

Permalink
has issue ith interger_kinds being zero in kind_to_type
Browse files Browse the repository at this point in the history
  • Loading branch information
@brtnfld
brtnfld committed Nov 2, 2023
1 parent 61982b6 commit af85a54
Show file tree
Hide file tree
Showing 6 changed files with 37 additions and 51 deletions.
2 changes: 1 addition & 1 deletion configure.ac
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@
## ----------------------------------------------------------------------
## Initialize configure.
##
AC_PREREQ([2.71])
AC_PREREQ([2.69])

## AC_INIT takes the name of the package, the version number, and an
## email address to report bugs. AC_CONFIG_SRCDIR takes a unique file
Expand Down
6 changes: 5 additions & 1 deletion fortran/src/H5_ff.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -967,6 +967,7 @@ END SUBROUTINE h5get_free_list_sizes_f
!!
INTEGER(HID_T) FUNCTION h5kind_to_type(ikind, flag) RESULT(h5_type)
USE ISO_C_BINDING
USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : integer_kinds, real_kinds
IMPLICIT NONE
INTEGER, INTENT(IN) :: ikind
INTEGER, INTENT(IN) :: flag
Expand All @@ -980,7 +981,10 @@ INTEGER(HID_T) FUNCTION h5kind_to_type(ikind, flag) RESULT(h5_type)

h5_type = -1
IF(flag.EQ.H5_INTEGER_KIND)THEN
do_kind: DO i = 1, H5_FORTRAN_NUM_INTEGER_KINDS
do_kind: DO i = 1, SIZE(integer_kinds)
PRINT*,integer_kinds
PRINT*,real_kinds
PRINT*, Fortran_INTEGER_AVAIL_KINDS(i), integer_kinds(i)
IF(ikind.EQ.Fortran_INTEGER_AVAIL_KINDS(i))THEN
h5_type = H5T_NATIVE_INTEGER_KIND(i)
EXIT do_kind
Expand Down
30 changes: 17 additions & 13 deletions fortran/src/H5match_types.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -131,14 +131,18 @@ writeTypedefDefault(const char *c_typedef, int size)
void
writeToFiles(const char *c_typedef, const char *fortran_type, const char *c_type, int kind)
{
if(fortran_type != NULL)
fprintf(fort_header, " INTEGER, PARAMETER :: %s = %u\n", fortran_type, kind);
if(c_typedef != NULL)
fprintf(c_header, "typedef c_%s_%d %s;\n", c_typedef, kind, c_type);
}
void
writeToFilesChr(const char *c_typedef, const char *fortran_type, const char *c_type, int size,
const char *kind)
{
if(fortran_type != NULL)
fprintf(fort_header, " INTEGER, PARAMETER :: %s = %s\n", fortran_type, kind);
if(c_typedef != NULL)
fprintf(c_header, "typedef c_%s_%d %s;\n", c_typedef, size, c_type);
}
int
Expand Down Expand Up @@ -334,7 +338,7 @@ main(void)
/* int_1, int_2, int_4, int_8 */

/* Defined different KINDs of integers */

#if 1
fprintf(fort_header, " INTEGER, DIMENSION(1:%d), PARAMETER :: Fortran_INTEGER_AVAIL_KINDS = (/",
FORTRAN_NUM_INTEGER_KINDS);

Expand All @@ -347,7 +351,7 @@ main(void)
fprintf(fort_header, ",");
}
}

#endif
/* real_4, real_8, real_16 */

/* Defined different KINDs of reals: */
Expand Down Expand Up @@ -376,23 +380,23 @@ main(void)
/* real_f */
#if H5_FORTRAN_HAVE_C_LONG_DOUBLE != 0
if (H5_FORTRAN_NATIVE_REAL_SIZEOF == sizeof(long double)) {
writeToFilesChr("float", "Fortran_REAL", "real_f", H5_FORTRAN_NATIVE_REAL_KIND, "C_LONG_DOUBLE");
writeToFilesChr("float", NULL, "real_f", H5_FORTRAN_NATIVE_REAL_KIND, "C_LONG_DOUBLE");
}
else
#endif
if (H5_FORTRAN_NATIVE_REAL_SIZEOF == sizeof(double)) {
writeToFilesChr("float", "Fortran_REAL", "real_f", H5_FORTRAN_NATIVE_REAL_KIND, "C_DOUBLE");
writeToFilesChr("float", NULL, "real_f", H5_FORTRAN_NATIVE_REAL_KIND, "C_DOUBLE");
}
else if (H5_FORTRAN_NATIVE_REAL_SIZEOF == sizeof(float))
writeToFilesChr("float", "Fortran_REAL", "real_f", H5_FORTRAN_NATIVE_REAL_KIND, "C_FLOAT");
writeToFilesChr("float", NULL, "real_f", H5_FORTRAN_NATIVE_REAL_KIND, "C_FLOAT");
else {
/* No exact match, choose the next highest */
if (H5_FORTRAN_NATIVE_REAL_SIZEOF > sizeof(long double))
writeToFilesChr("float", "Fortran_REAL", "real_f", H5_FORTRAN_NATIVE_REAL_KIND, "C_LONG_DOUBLE");
writeToFilesChr("float", NULL, "real_f", H5_FORTRAN_NATIVE_REAL_KIND, "C_LONG_DOUBLE");
else if (H5_FORTRAN_NATIVE_REAL_SIZEOF > sizeof(double))
writeToFilesChr("float", "Fortran_REAL", "real_f", H5_FORTRAN_NATIVE_REAL_KIND, "C_DOUBLE");
writeToFilesChr("float", NULL, "real_f", H5_FORTRAN_NATIVE_REAL_KIND, "C_DOUBLE");
else if (H5_FORTRAN_NATIVE_REAL_SIZEOF > sizeof(float))
writeToFilesChr("float", "Fortran_REAL", "real_f", H5_FORTRAN_NATIVE_REAL_KIND, "C_FLOAT");
writeToFilesChr("float", NULL, "real_f", H5_FORTRAN_NATIVE_REAL_KIND, "C_FLOAT");
else {
/* Error: couldn't find a size for real_f */
printf("Error: couldn't find a size for real_f \n");
Expand All @@ -403,25 +407,25 @@ main(void)
/* double_f */
#if H5_FORTRAN_HAVE_C_LONG_DOUBLE != 0
if (H5_FORTRAN_NATIVE_DOUBLE_SIZEOF == sizeof(long double)) {
writeToFilesChr("float", "Fortran_DOUBLE", "double_f", H5_FORTRAN_NATIVE_DOUBLE_KIND,
writeToFilesChr("float", NULL, "double_f", H5_FORTRAN_NATIVE_DOUBLE_KIND,
"C_LONG_DOUBLE");
}
else
#endif
if (H5_FORTRAN_NATIVE_DOUBLE_SIZEOF == sizeof(double)) {
writeToFilesChr("float", "Fortran_DOUBLE", "double_f", H5_FORTRAN_NATIVE_DOUBLE_KIND, "C_DOUBLE");
writeToFilesChr("float", NULL, "double_f", H5_FORTRAN_NATIVE_DOUBLE_KIND, "C_DOUBLE");
}
else if (H5_FORTRAN_NATIVE_DOUBLE_SIZEOF == sizeof(float))
writeToFilesChr("float", "Fortran_DOUBLE", "double_f", H5_FORTRAN_NATIVE_DOUBLE_KIND, "C_FLOAT");
writeToFilesChr("float", NULL, "double_f", H5_FORTRAN_NATIVE_DOUBLE_KIND, "C_FLOAT");
#ifdef H5_HAVE_FLOAT128
/* Don't select a higher precision than Fortran can support */
else if (sizeof(__float128) == H5_FORTRAN_NATIVE_DOUBLE_SIZEOF && H5_PAC_FC_MAX_REAL_PRECISION > 28) {
writeToFilesChr("float", "Fortran_DOUBLE", "double_f", H5_FORTRAN_NATIVE_DOUBLE_KIND,
writeToFilesChr("float", NULL, "double_f", H5_FORTRAN_NATIVE_DOUBLE_KIND,
"Fortran_REAL_C_FLOAT128");
}
#else
else if (sizeof(long double) == H5_FORTRAN_NATIVE_DOUBLE_SIZEOF && H5_PAC_FC_MAX_REAL_PRECISION > 28) {
writeToFilesChr("float", "Fortran_DOUBLE", "double_f", H5_FORTRAN_NATIVE_DOUBLE_KIND,
writeToFilesChr("float", NULL, "double_f", H5_FORTRAN_NATIVE_DOUBLE_KIND,
"Fortran_REAL_C_FLOAT128");
}
#endif
Expand Down
4 changes: 2 additions & 2 deletions fortran/test/tH5A.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,8 @@ SUBROUTINE attribute_test(cleanup, total_error)
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error

INTEGER, PARAMETER :: Fortran_DOUBLE = KIND(1.D0)

CHARACTER(LEN=5), PARAMETER :: filename = "atest" !File name
CHARACTER(LEN=80) :: fix_filename
CHARACTER(LEN=9), PARAMETER :: dsetname = "atestdset" !Dataset name
Expand All @@ -58,8 +60,6 @@ SUBROUTINE attribute_test(cleanup, total_error)
INTEGER, PARAMETER :: NX = 4
INTEGER, PARAMETER :: NY = 5



INTEGER(HID_T) :: file_id ! File identifier
INTEGER(HID_T) :: dset_id ! Dataset identifier
INTEGER(HID_T) :: dataspace ! Dataspace identifier for dataset
Expand Down
2 changes: 2 additions & 0 deletions fortran/test/tH5T.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -53,6 +53,8 @@ SUBROUTINE compoundtest(cleanup, total_error)
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(OUT) :: total_error

INTEGER, PARAMETER :: Fortran_DOUBLE = KIND(1.D0)

CHARACTER(LEN=8), PARAMETER :: filename = "compound" ! File name
CHARACTER(LEN=80) :: fix_filename
CHARACTER(LEN=8), PARAMETER :: dsetname = "Compound" ! Dataset name
Expand Down
44 changes: 10 additions & 34 deletions m4/aclocal_fc.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -82,27 +82,17 @@ END PROGRAM PROG_FC_C_LONG_DOUBLE_EQ_C_DOUBLE

!---- START ----- Determine the available KINDs for REALs and INTEGERs
PROGRAM FC_AVAIL_KINDS
USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : stdout=>OUTPUT_UNIT
USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : stdout=>OUTPUT_UNIT, integer_kinds, real_kinds
IMPLICIT NONE
INTEGER :: ik, jk, k, kk, max_decimal_prec
INTEGER :: prev_rkind, num_rkinds = 1, num_ikinds = 1
INTEGER, DIMENSION(1:10) :: list_ikinds = -1
INTEGER, DIMENSION(1:10) :: list_rkinds = -1
LOGICAL :: new_kind
INTEGER :: ik, jk, k, max_decimal_prec
INTEGER :: num_rkinds, num_ikinds

! Find integer KINDs
list_ikinds(num_ikinds)=SELECTED_INT_KIND(1)
DO ik = 2, 36
k = SELECTED_INT_KIND(ik)
IF(k.LT.0) EXIT
IF(k.GT.list_ikinds(num_ikinds))THEN
num_ikinds = num_ikinds + 1
list_ikinds(num_ikinds) = k
ENDIF
ENDDO

num_ikinds = SIZE(integer_kinds)

DO k = 1, num_ikinds
WRITE(stdout,'(I0)', ADVANCE='NO') list_ikinds(k)
WRITE(stdout,'(I0)', ADVANCE='NO') integer_kinds(k)
IF(k.NE.num_ikinds)THEN
WRITE(stdout,'(A)',ADVANCE='NO') ','
ELSE
Expand All @@ -111,35 +101,21 @@ PROGRAM FC_AVAIL_KINDS
ENDDO

! Find real KINDs
list_rkinds(num_rkinds)=SELECTED_REAL_KIND(1)

num_rkinds = SIZE(real_kinds)

max_decimal_prec = 1
prev_rkind=list_rkinds(num_rkinds)

prec: DO ik = 2, 36
exp: DO jk = 1, 700
k = SELECTED_REAL_KIND(ik,jk)
IF(k.LT.0) EXIT exp
IF(k.NE.prev_rkind)THEN
! Check if we already have that kind
new_kind = .TRUE.
DO kk = 1, num_rkinds
IF(k.EQ.list_rkinds(kk))THEN
new_kind=.FALSE.
EXIT
ENDIF
ENDDO
IF(new_kind)THEN
num_rkinds = num_rkinds + 1
list_rkinds(num_rkinds) = k
prev_rkind=list_rkinds(num_rkinds)
ENDIF
ENDIF
max_decimal_prec = ik
ENDDO exp
ENDDO prec

DO k = 1, num_rkinds
WRITE(stdout,'(I0)', ADVANCE='NO') list_rkinds(k)
WRITE(stdout,'(I0)', ADVANCE='NO') real_kinds(k)
IF(k.NE.num_rkinds)THEN
WRITE(stdout,'(A)',ADVANCE='NO') ','
ELSE
Expand Down

0 comments on commit af85a54

Please sign in to comment.