summaryrefslogtreecommitdiffstats
path: root/fortran/src
diff options
context:
space:
mode:
Diffstat (limited to 'fortran/src')
-rw-r--r--fortran/src/H5match_types.c46
-rw-r--r--fortran/src/H5test_kind.F9048
2 files changed, 86 insertions, 8 deletions
diff --git a/fortran/src/H5match_types.c b/fortran/src/H5match_types.c
index 14b76a4..d162634 100644
--- a/fortran/src/H5match_types.c
+++ b/fortran/src/H5match_types.c
@@ -51,6 +51,7 @@ FILE * fort_header;
void writeTypedef(const char* c_typedef, const char* c_type, unsigned int size);
void writeTypedefDefault(const char* c_typedef, unsigned int size);
void writeToFiles(const char* c_typedef, const char* fortran_type, const char* c_type, int size, unsigned int kind);
+void writeToFilesChr(const char* c_typedef, const char* fortran_type, const char* c_type, int size, char* kind);
static void
initCfile(void)
@@ -100,6 +101,7 @@ initFfile(void)
!\n!\n\
! This file is automatically generated and contains HDF5 Fortran90 type definitions.\n!\n\
MODULE H5FORTRAN_TYPES\n\
+ USE ISO_C_BINDING\n\
!\n\
! HDF5 integers\n\
!\n");
@@ -137,6 +139,11 @@ void writeToFiles(const char* c_typedef, const char* fortran_type, const char* c
fprintf(fort_header, " INTEGER, PARAMETER :: %s = %u\n", fortran_type, kind);
fprintf(c_header, "typedef c_%s_%d %s;\n", c_typedef, size, c_type);
}
+void writeToFilesChr(const char* c_typedef, const char* fortran_type, const char* c_type, int size, char* kind)
+{
+ fprintf(fort_header, " INTEGER, PARAMETER :: %s = %s\n", fortran_type, kind);
+ fprintf(c_header, "typedef c_%s_%d %s;\n", c_typedef, size, c_type);
+}
int main(void)
{
@@ -532,12 +539,12 @@ int main(void)
/* real_f */
#if defined H5_FORTRAN_HAS_REAL_NATIVE_16_KIND
if(H5_C_HAS_REAL_NATIVE_16 != 0) {
- writeToFiles("float","Fortran_REAL", "real_f", 16, H5_FORTRAN_HAS_REAL_NATIVE_16_KIND);
+ writeToFilesChr("float","Fortran_REAL", "real_f", 16, "C_LONG_DOUBLE");
}
#elif defined H5_FORTRAN_HAS_REAL_NATIVE_8_KIND
- writeToFiles("float", "Fortran_REAL", "real_f", 8, H5_FORTRAN_HAS_REAL_NATIVE_8_KIND);
+ writeToFilesChr("float", "Fortran_REAL", "real_f", 8, "C_DOUBLE");
#elif defined H5_FORTRAN_HAS_REAL_NATIVE_4_KIND
- writeToFiles("float", "Fortran_REAL", "real_f", 4, H5_FORTRAN_HAS_REAL_NATIVE_4_KIND);
+ writeToFilesChr("float", "Fortran_REAL", "real_f", 4, "C_FLOAT");
#else
/* Error: couldn't find a size for real_f */
return -1;
@@ -546,13 +553,13 @@ int main(void)
/* double_f */
#if defined H5_FORTRAN_HAS_DOUBLE_NATIVE_16_KIND
if(H5_C_HAS_REAL_NATIVE_16 != 0) { /* Check if C has 16 byte floats */
- writeToFiles("float", "Fortran_DOUBLE", "double_f", 16, H5_FORTRAN_HAS_DOUBLE_NATIVE_16_KIND);
+ writeToFilesChr("float", "Fortran_DOUBLE", "double_f", 16, "C_LONG_DOUBLE");
} else {
#if defined H5_FORTRAN_HAS_REAL_NATIVE_8_KIND /* Fall back to 8 byte floats */
- writeToFiles("float", "Fortran_DOUBLE", "double_f", 8, H5_FORTRAN_HAS_REAL_NATIVE_8_KIND);
+ writeToFilesChr("float", "Fortran_DOUBLE", "double_f", 8, "C_DOUBLE");
}
#elif defined H5_FORTRAN_HAS_REAL_NATIVE_4_KIND /* Fall back to 4 byte floats */
- writeToFiles("float", "Fortran_DOUBLE", "double_f", 4, H5_FORTRAN_HAS_REAL_NATIVE_4_KIND);
+ writeToFilesChr("float", "Fortran_DOUBLE", "double_f", 4, "C_FLOAT");
}
#else
/* Error: couldn't find a size for double_f when fortran has 16 byte reals */
@@ -561,12 +568,37 @@ int main(void)
#endif
#elif defined H5_FORTRAN_HAS_DOUBLE_NATIVE_8_KIND
- writeToFiles("float", "Fortran_DOUBLE", "double_f", 8, H5_FORTRAN_HAS_DOUBLE_NATIVE_8_KIND);
+ writeToFilesChr("float", "Fortran_DOUBLE", "double_f", 8, "C_DOUBLE");
#else
/* Error: couldn't find a size for real_f */
return -1;
#endif
+/* /\* real_f *\/ */
+/* if(sizeof(float) == C_LONG_DOUBLE_SIZEOF) { */
+/* writeToFilesChr("float","Fortran_REAL", "real_f", (int)sizeof(float), "C_LONG_DOUBLE"); */
+/* } else if(sizeof(float) == C_DOUBLE_SIZEOF) { */
+/* writeToFilesChr("float","Fortran_REAL", "real_f", (int)sizeof(float), "C_DOUBLE"); */
+/* } else if(sizeof(float) == C_FLOAT_SIZEOF) { */
+/* writeToFilesChr("float","Fortran_REAL", "real_f", (int)sizeof(float), "C_FLOAT"); */
+/* } else { */
+/* /\* Error: couldn't find a size for real_f *\/ */
+/* return -1; */
+/* } */
+
+/* /\* double_f *\/ */
+/* if(sizeof(double) == C_LONG_DOUBLE_SIZEOF) { */
+/* writeToFilesChr("float","Fortran_DOUBLE", "double_f", (int)sizeof(double), "C_LONG_DOUBLE"); */
+/* } else if(sizeof(double) == C_DOUBLE_SIZEOF) { */
+/* writeToFilesChr("float","Fortran_DOUBLE", "double_f", (int)sizeof(double), "C_DOUBLE"); */
+/* } else if(sizeof(double) == C_FLOAT_SIZEOF) { */
+/* writeToFilesChr("float","Fortran_DOUBLE", "double_f", (int)sizeof(double), "C_FLOAT"); */
+/* } else { */
+/* /\* Error: couldn't find a size for double_f *\/ */
+/* return -1; */
+/* } */
+
+
/* Need the buffer size for the fortran derive type 'hdset_reg_ref_t_f03'
* in order to be interoperable with C's structure, the C buffer size
* H5R_DSET_REG_REF_BUF_SIZE is (sizeof(haddr_t)+4)
diff --git a/fortran/src/H5test_kind.F90 b/fortran/src/H5test_kind.F90
index 6cd75bc..3ad1a66 100644
--- a/fortran/src/H5test_kind.F90
+++ b/fortran/src/H5test_kind.F90
@@ -49,9 +49,17 @@
#include "H5config_f.inc"
PROGRAM test_kind
+ USE, INTRINSIC :: ISO_C_BINDING
IMPLICIT NONE
INTEGER :: i, j, ii, ir, last, ikind_numbers(10), rkind_numbers(10)
INTEGER :: ji, jr, jd
+#ifdef HAVE_C_LONG_DOUBLE
+ REAL(KIND=C_LONG_DOUBLE) :: c_longdble
+#endif
+ REAL(KIND=C_DOUBLE) :: c_dble
+ REAL(KIND=C_FLOAT) :: c_flt
+ INTEGER :: sizeof_var
+
last = -1
ii = 0
@@ -225,7 +233,8 @@ WRITE(*,'(40(A,/))') &
WRITE(*,*) "PROGRAM H5test_kind"
WRITE(*,*) "USE H5test_kind_mod"
- WRITE(*,*) "WRITE(*,*) "" /*generating header file*/ """
+ WRITE(*,*) "CHARACTER(LEN=2) :: jchr2"
+ WRITE(*,*) "WRITE(*,*) "" /*generated header file*/ """
ji = 0
WRITE(*, "("" CALL i"", i2.2,""()"")") ji
jr = 0
@@ -240,6 +249,43 @@ WRITE(*,'(40(A,/))') &
j = rkind_numbers(i)
WRITE(*, "("" CALL r"", i2.2,""()"")") j
ENDDO
+#ifdef HAVE_C_LONG_DOUBLE
+
+# ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
+ sizeof_var = STORAGE_SIZE(c_longdble, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)
+# else
+ sizeof_var = SIZEOF(c_longdble)
+# endif
+
+ WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", C_LONG_DOUBLE
+ WRITE(*,'(A)')' WRITE(*,*) "#define C_LONG_DOUBLE_KIND "'//"//ADJUSTL(jchr2)"
+ WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", sizeof_var
+ WRITE(*,'(A)')' WRITE(*,*) "#define C_LONG_DOUBLE_SIZEOF "'//"//ADJUSTL(jchr2)"
+#else
+ WRITE(*,'(A)')' WRITE(*,*) "#define C_LONG_DOUBLE_KIND -1"'
+ WRITE(*,'(A)')' WRITE(*,*) "#define C_LONG_DOUBLE_SIZEOF -1"'
+#endif
+
+#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
+ sizeof_var = STORAGE_SIZE(c_dble, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)
+#else
+ sizeof_var = SIZEOF(c_dble)
+#endif
+ WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", C_DOUBLE
+ WRITE(*,'(A)')' WRITE(*,*) "#define C_DOUBLE_KIND "'//"//ADJUSTL(jchr2)"
+ WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", sizeof_var
+ WRITE(*,'(A)')' WRITE(*,*) "#define C_DOUBLE_SIZEOF "'//"//ADJUSTL(jchr2)"
+
+#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE
+ sizeof_var = STORAGE_SIZE(c_flt, c_size_t)/STORAGE_SIZE(c_char_'a',c_size_t)
+#else
+ sizeof_var = SIZEOF(c_flt)
+#endif
+ WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", C_FLOAT
+ WRITE(*,'(A)')' WRITE(*,*) "#define C_FLOAT_KIND "'//"//ADJUSTL(jchr2)"
+ WRITE(*,'(A,I0)')" WRITE(jchr2,'(I2)') ", sizeof_var
+ WRITE(*,'(A)')' WRITE(*,*) "#define C_FLOAT_SIZEOF "'//"//ADJUSTL(jchr2)"
+
WRITE(*,*) "END PROGRAM H5test_kind"
END PROGRAM test_kind
generated by cgit v0.12 at 2024-11-03 11:36:19 (GMT)