summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'fortran')
-rw-r--r--fortran/src/H5_f.c20
-rw-r--r--fortran/src/H5f90i.h6
-rw-r--r--fortran/src/H5match_types.c135
3 files changed, 151 insertions, 10 deletions
diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c
index 745dfe4..a993451 100644
--- a/fortran/src/H5_f.c
+++ b/fortran/src/H5_f.c
@@ -59,14 +59,24 @@ nh5init_types_c( hid_t_f * types, hid_t_f * floatingtypes, hid_t_f * integertype
if ((types[0] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
} /*end else */
- /* Accomodate Crays with this check */
- if(sizeof(real_f)==sizeof(double)) {
+ /* Find appropriate size to store Fortran REAL */
+ if(sizeof(real_f)==sizeof(float)) {
+ if ((types[1] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value;
+ } /* end if */
+ else if(sizeof(real_f)==sizeof(double)){
if ((types[1] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
} /* end if */
- else {
- if ((types[1] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value;
+ else if (sizeof(real_f) == sizeof(long double)) {
+ if ((types[1] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
} /* end else */
- if ((types[2] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
+
+
+ if(sizeof(double_f)==sizeof(double)) {
+ if ((types[2] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
+ }/*end if */
+ else if(sizeof(double_f)==sizeof(long double)) {
+ if ((types[2] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
+ }/*end else */
/*
if ((types[3] = H5Tcopy(H5T_NATIVE_UINT8)) < 0) return ret_value;
diff --git a/fortran/src/H5f90i.h b/fortran/src/H5f90i.h
index 81065f0..abc1e99 100644
--- a/fortran/src/H5f90i.h
+++ b/fortran/src/H5f90i.h
@@ -18,11 +18,11 @@
/*
* Include generated header. This header defines integer types,
- * so this file only needs to define _fcd and real_f.
+ * so this file only needs to define _fcd.
*/
#include "H5f90i_gen.h"
-/* Define _fcd and real_f. These are the same on every system
+/* Define _fcd. These are the same on every system
* but UNICOS.
*/
#define _fcdtocp(desc) (desc)
@@ -32,12 +32,10 @@
#include <fortran.h>
/*typedef char* _fcd;*/
-typedef double real_f;
#else
typedef char *_fcd;
-typedef float real_f;
#endif
diff --git a/fortran/src/H5match_types.c b/fortran/src/H5match_types.c
index 4900aac..503a7a5 100644
--- a/fortran/src/H5match_types.c
+++ b/fortran/src/H5match_types.c
@@ -87,6 +87,18 @@ void writeTypedef(const char* c_type, unsigned int size)
fprintf(c_header, "#define c_int_%d %s\n", size, c_type);
}
+/* Define a c_float_x type in the C header */
+void writeFloatTypedef(const char* c_type, unsigned int size)
+{
+ fprintf(c_header, "#define c_float_%d %s\n", size, c_type);
+}
+
+/* Define a c_double_x type in the C header */
+void writeDoubleTypedef(const char* c_type, unsigned int size)
+{
+ fprintf(c_header, "#define c_double_%d %s\n", size, c_type);
+}
+
/* Call this function if there is no matching C type for sizes > 1 */
void writeTypedefDefault(unsigned int size)
{
@@ -102,6 +114,23 @@ void writeToFiles(const char* fortran_type, const char* c_type, unsigned int siz
fprintf(c_header, "typedef c_int_%d %s;\n", size, c_type);
}
+/* Create matching Fortran and C floating types by writing to both files */
+void writeFloatToFiles(const char* fortran_type, const char* c_type, unsigned int size)
+{
+ fprintf(fort_header, " INTEGER, PARAMETER :: %s = %d\n", fortran_type, size);
+
+ fprintf(c_header, "typedef c_float_%d %s;\n", size, c_type);
+}
+
+/* Create matching Fortran and C floating types by writing to both files */
+void writeDoubleToFiles(const char* fortran_type, const char* c_type, unsigned int size)
+{
+ fprintf(fort_header, " INTEGER, PARAMETER :: %s = %d\n", fortran_type, size);
+
+ fprintf(c_header, "typedef c_double_%d %s;\n", size, c_type);
+}
+
+
int main()
{
/* Open target files */
@@ -113,6 +142,8 @@ int main()
initFfile();
/* First, define c_int_x */
+
+#if defined H5_FORTRAN_HAS_INTEGER_1
if(sizeof(long_long) == 1)
writeTypedef("long_long", 1);
else if(sizeof(long) == 1)
@@ -126,7 +157,9 @@ int main()
/* Actually, char is not necessarily one byte.
* But if char isn't, then nothing is, so this
* is as close as we can get. */
+#endif /*H5_FORTRAN_HAS_INTEGER_1 */
+#if defined H5_FORTRAN_HAS_INTEGER_2
if(sizeof(long_long) == 2)
writeTypedef("long_long", 2);
else if(sizeof(long) == 2)
@@ -137,7 +170,9 @@ int main()
writeTypedef("short", 2);
else
writeTypedefDefault(2);
+#endif /*H5_FORTRAN_HAS_INTEGER_2 */
+#if defined H5_FORTRAN_HAS_INTEGER_4
if(sizeof(long_long) == 4)
writeTypedef("long_long", 4);
else if(sizeof(long) == 4)
@@ -148,7 +183,9 @@ int main()
writeTypedef("short", 4);
else
writeTypedefDefault(4);
+#endif /*H5_FORTRAN_HAS_INTEGER_4 */
+#if defined H5_FORTRAN_HAS_INTEGER_8
if(sizeof(long_long) == 8)
writeTypedef("long_long", 8);
else if(sizeof(long) == 8)
@@ -159,10 +196,84 @@ int main()
writeTypedef("short", 8);
else
writeTypedefDefault(8);
+#endif /*H5_FORTRAN_HAS_INTEGER_8 */
+
+ /* Define c_float_x */
+
+#if defined H5_FORTRAN_HAS_REAL_NATIVE_4
+ if(sizeof(long double) == 4)
+ writeFloatTypedef("long double", 4);
+ else if(sizeof(double) == 4)
+ writeFloatTypedef("double", 4);
+ else if(sizeof(float) == 4)
+ writeFloatTypedef("float", 4);
+ else
+ { printf("Fortran REAL is 4 bytes, no corresponding C floating type\n");
+ printf("Quitting....\n");
+ return -1;
+ }
+#endif /*H5_FORTRAN_HAS_REAL_NATIVE_4*/
+
+#if defined H5_FORTRAN_HAS_REAL_NATIVE_8
+ if(sizeof(long double) == 8)
+ writeFloatTypedef("long double", 8);
+ else if(sizeof(double) == 8)
+ writeFloatTypedef("double", 8);
+ else if(sizeof(float) == 8)
+ writeFloatTypedef("float", 8);
+ else
+ { printf("Fortran REAL is 16 bytes, no corresponding C floating type\n");
+ printf("Quitting....\n");
+ return -1;
+ }
+#endif /*H5_FORTRAN_HAS_REAL_NATIVE_8*/
+
+#if defined H5_FORTRAN_HAS_REAL_NATIVE_16
+ if(sizeof(long double) == 16)
+ writeFloatTypedef("long double", 16);
+ else if(sizeof(double) == 16)
+ writeFloatTypedef("double", 16);
+ else if(sizeof(float) == 16)
+ writeFloatTypedef("float", 16);
+ else
+ { printf("Fortran REAL is 16 bytes, no corresponding C floating type\n");
+ printf("Quitting....\n");
+ return -1;
+ }
+#endif /*H5_FORTRAN_HAS_REAL_NATIVE_16*/
+
+ /* Define c_double_x */
+
+#if defined H5_FORTRAN_HAS_DOUBLE_NATIVE_8
+ if(sizeof(long double) == 8)
+ writeDoubleTypedef("long double", 8);
+ else if(sizeof(double) == 8)
+ writeDoubleTypedef("double", 8);
+ else if(sizeof(float) == 8)
+ writeDoubleTypedef("float", 8);
+ else
+ { printf("Fortran DOUBLE is 16 bytes, no corresponding C floating type\n");
+ printf("Quitting....\n");
+ return -1;
+ }
+#endif /*H5_FORTRAN_HAS_DOUBLE_NATIVE_8*/
+
+#if defined H5_FORTRAN_HAS_DOUBLE_NATIVE_16
+ if(sizeof(long double) == 16)
+ writeDoubleTypedef("long double", 16);
+ else if(sizeof(double) == 16)
+ writeDoubleTypedef("double", 16);
+ else if(sizeof(float) == 16)
+ writeDoubleTypedef("float", 16);
+ else
+ { printf("Fortran DOUBLE is 16 bytes, no corresponding C floating type\n");
+ printf("Quitting....\n");
+ return -1;
+ }
+#endif /*H5_FORTRAN_HAS_DOUBLE_NATIVE_16*/
/* Now begin defining fortran types. */
fprintf(c_header, "\n");
-
/* haddr_t */
#if defined H5_FORTRAN_HAS_INTEGER_8 && H5_SIZEOF_HADDR_T >= 8
writeToFiles("HADDR_T", "haddr_t_f", 8);
@@ -250,6 +361,28 @@ int main()
return -1;
#endif
+ /* real_f */
+#if defined H5_FORTRAN_HAS_REAL_NATIVE_16
+ writeFloatToFiles("Fortran_REAL", "real_f", 16);
+#elif defined H5_FORTRAN_HAS_REAL_NATIVE_8
+ writeFloatToFiles("Fortran_REAL", "real_f", 8);
+#elif defined H5_FORTRAN_HAS_REAL_NATIVE_4
+ writeFloatToFiles("Fortran_REAL", "real_f", 4);
+#else
+ /* Error: couldn't find a size for real_f */
+ return -1;
+#endif
+
+ /* double_f */
+#if defined H5_FORTRAN_HAS_DOUBLE_NATIVE_16
+ writeDoubleToFiles("Fortran_DOUBLE", "double_f", 16);
+#elif defined H5_FORTRAN_HAS_DOUBLE_NATIVE_8
+ writeDoubleToFiles("Fortran_DOUBLE", "double_f", 8);
+#else
+ /* Error: couldn't find a size for real_f */
+ return -1;
+#endif
+
/* Close files */
endCfile();
endFfile();
generated by cgit v0.12 at 2024-12-28 16:02:29 (GMT)