HDFFV-9973 Fortran library fails to compile and fails tests with NAG compiler

Fixes issues with KIND = BYTE assumptions.

1 files changed, 89 insertions, 147 deletions

diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c
index d7b952d..9d4c297 100644
--- a/fortran/src/H5_f.c
+++ b/fortran/src/H5_f.c
@@ -23,6 +23,10 @@
 
 #include "H5f90.h"
 #include "H5fort_type_defines.h"
+
+int IntKinds_SizeOf[] = H5_FORTRAN_INTEGER_KINDS_SIZEOF;
+
+
 /****if* H5_f/h5init_types_c
  * NAME
  *  h5init_types_c
@@ -55,173 +59,136 @@ h5init_types_c( hid_t_f * types, hid_t_f * floatingtypes, hid_t_f * integertypes
     int ret_value = -1;
     hid_t c_type_id;
     size_t tmp_val;
+    int i;
+
+    /* Fortran INTEGER may not be the same as C; do all checking to find
+       an appropriate size
+    */
+
+    /*
+     * FIND H5T_NATIVE_INTEGER_#
+     */
+    for(i=0;i<4;i++) {
+
+      if ( IntKinds_SizeOf[i] == sizeof(char)) {
+	if ((types[i] = (hid_t_f)H5Tcopy(H5T_NATIVE_CHAR)) < 0) return ret_value;
+      } /*end if */
+      else if ( IntKinds_SizeOf[i] == sizeof(short)) {
+	if ((types[i] = (hid_t_f)H5Tcopy(H5T_NATIVE_SHORT)) < 0) return ret_value;
+      } /*end if */
+      else if ( IntKinds_SizeOf[i] == sizeof(int)) {
+	if ((types[i] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
+      } /*end if */
+      else if ( IntKinds_SizeOf[i] == sizeof(long long)) {
+	if ((types[i] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
+      } /*end if */
+      else {
+	if ((types[i] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
+	if ( H5Tset_precision (types[i], 128) < 0) return ret_value;
+      } /*end else */
+
+    }
+
+#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
+     /*
+     * FIND H5T_NATIVE_INTEGER_KIND(5), INTEGER*16
+     */
+    if (sizeof(int_16_f) == sizeof(char)) {
+      if ((types[4] = (hid_t_f)H5Tcopy(H5T_NATIVE_CHAR)) < 0) return ret_value;
+    } /*end if */
+    else if (sizeof(int_16_f) == sizeof(short)) {
+      if ((types[4] = (hid_t_f)H5Tcopy(H5T_NATIVE_SHORT)) < 0) return ret_value;
+    } /*end if */
+    else if (sizeof(int_16_f) == sizeof(int)) {
+      if ((types[4] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
+    } /*end if */
+    else if (sizeof(int_16_f) == sizeof(long long)) {
+	if ((types[4] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
+    } /*end else */
+    else {
+      if ((types[4] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
+      if ( H5Tset_precision (types[4], 128) < 0) return ret_value;
+    } /*end else */
+#else
+    if ((types[4] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
+    if ( H5Tset_precision (types[4], 128) < 0) return ret_value;
+#endif
 
-/* Fortran INTEGER may not be the same as C; do all checking to find
-   an appropriate size
-*/
     if (sizeof(int_f) == sizeof(int)) {
-    if ((types[0] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
+    if ((types[5] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
     } /*end if */
     else if (sizeof(int_f) == sizeof(long)) {
-    if ((types[0] = (hid_t_f)H5Tcopy(H5T_NATIVE_LONG)) < 0) return ret_value;
+    if ((types[5] = (hid_t_f)H5Tcopy(H5T_NATIVE_LONG)) < 0) return ret_value;
     } /*end if */
     else
     if (sizeof(int_f) == sizeof(long long)) {
-    if ((types[0] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
+    if ((types[5] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
     } /*end else */
 
     /* 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;
+        if ((types[6] = (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;
+        if ((types[6] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
     } /* end if */
 #if H5_SIZEOF_LONG_DOUBLE!=0
     else if (sizeof(real_f) == sizeof(long double)) {
-        if ((types[1] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
+        if ((types[6] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
     } /* end else */
 #endif
 
     /* Find appropriate size to store Fortran DOUBLE */
     if(sizeof(double_f)==sizeof(double)) {
-       if ((types[2] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
+       if ((types[7] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
     }/*end if */
 #if H5_SIZEOF_LONG_DOUBLE!=0
     else if(sizeof(double_f)==sizeof(long double)) {
-       if ((types[2] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
+       if ((types[7] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
     }/*end else */
 #endif
 #ifdef H5_HAVE_FLOAT128
     else if(sizeof(double_f)==sizeof(__float128)) {
-      if ((types[2] = H5Tcopy (H5T_NATIVE_FLOAT)) < 0) return ret_value;
-      if ( H5Tset_precision (types[2], 128) < 0) return ret_value;
+      if ((types[7] = H5Tcopy (H5T_NATIVE_FLOAT)) < 0) return ret_value;
+      if ( H5Tset_precision (types[7], 128) < 0) return ret_value;
     }/*end else */
 #endif
 
-/*
-    if ((types[3] = H5Tcopy(H5T_NATIVE_UINT8)) < 0) return ret_value;
-*/
     if ((c_type_id = H5Tcopy(H5T_FORTRAN_S1)) < 0) return ret_value;
     tmp_val = 1;
     if(H5Tset_size(c_type_id, tmp_val) < 0) return ret_value;
     if(H5Tset_strpad(c_type_id, H5T_STR_SPACEPAD) < 0) return ret_value;
-    types[3] = (hid_t_f)c_type_id;
-
-/*
-    if ((types[3] = H5Tcopy(H5T_C_S1)) < 0) return ret_value;
-    if(H5Tset_strpad(types[3],H5T_STR_NULLTERM) < 0) return ret_value;
-    if(H5Tset_size(types[3],1) < 0) return ret_value;
-*/
+    types[8] = (hid_t_f)c_type_id;
 
-
-/*    if ((types[3] = H5Tcopy(H5T_STD_I8BE)) < 0) return ret_value;
-*/
-    if ((types[4] = (hid_t_f)H5Tcopy(H5T_STD_REF_OBJ)) < 0) return ret_value;
-    if ((types[5] = (hid_t_f)H5Tcopy(H5T_STD_REF_DSETREG)) < 0) return ret_value;
-    /*
-     * FIND H5T_NATIVE_INTEGER_1
-     */
-    if (sizeof(int_1_f) == sizeof(char)) {
-      if ((types[6] = (hid_t_f)H5Tcopy(H5T_NATIVE_CHAR)) < 0) return ret_value;
-    } /*end if */
-    else if (sizeof(int_1_f) == sizeof(short)) {
-      if ((types[6] = (hid_t_f)H5Tcopy(H5T_NATIVE_SHORT)) < 0) return ret_value;
-    } /*end if */
-    else if (sizeof(int_1_f) == sizeof(int)) {
-      if ((types[6] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
-    } /*end if */
-    else if (sizeof(int_1_f) == sizeof(long long)) {
-      if ((types[6] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
-    } /*end if */
-    else {
-      if ((types[6] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
-      if ( H5Tset_precision (types[6], 128) < 0) return ret_value;
-    } /*end else */
-    /*
-     * FIND H5T_NATIVE_INTEGER_2
-     */
-    if (sizeof(int_2_f) == sizeof(char)) {
-      if ((types[7] = (hid_t_f)H5Tcopy(H5T_NATIVE_CHAR)) < 0) return ret_value;
-    } /*end if */
-    else if (sizeof(int_2_f) == sizeof(short)) {
-      if ((types[7] = (hid_t_f)H5Tcopy(H5T_NATIVE_SHORT)) < 0) return ret_value;
-    } /*end if */
-    else if (sizeof(int_2_f) == sizeof(int)) {
-      if ((types[7] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
-    } /*end if */
-    else if (sizeof(int_2_f) == sizeof(long long)) {
-	if ((types[7] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
-    } /*end else */
-    else {
-      if ((types[7] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
-      if ( H5Tset_precision (types[7], 128) < 0) return ret_value;
-    } /*end else */
-    /*
-     * FIND H5T_NATIVE_INTEGER_4
-     */
-    if (sizeof(int_4_f) == sizeof(char)) {
-      if ((types[8] = (hid_t_f)H5Tcopy(H5T_NATIVE_CHAR)) < 0) return ret_value;
-    } /*end if */
-    else if (sizeof(int_4_f) == sizeof(short)) {
-      if ((types[8] = (hid_t_f)H5Tcopy(H5T_NATIVE_SHORT)) < 0) return ret_value;
-    } /*end if */
-    else if (sizeof(int_4_f) == sizeof(int)) {
-      if ((types[8] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
-    } /*end if */
-    else if (sizeof(int_4_f) == sizeof(long long)) {
-	if ((types[8] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
-    } /*end else */
-    else {
-      if ((types[8] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
-      if ( H5Tset_precision (types[8], 128) < 0) return ret_value;
-    } /*end else */
-    /*
-     * FIND H5T_NATIVE_INTEGER_8
-     */
-    if (sizeof(int_8_f) == sizeof(char)) {
-      if ((types[9] = (hid_t_f)H5Tcopy(H5T_NATIVE_CHAR)) < 0) return ret_value;
-    } /*end if */
-    else if (sizeof(int_8_f) == sizeof(short)) {
-      if ((types[9] = (hid_t_f)H5Tcopy(H5T_NATIVE_SHORT)) < 0) return ret_value;
-    } /*end if */
-    else if (sizeof(int_8_f) == sizeof(int)) {
-      if ((types[9] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
-    } /*end if */
-    else if (sizeof(int_8_f) == sizeof(long long)) {
-	if ((types[9] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
-    } /*end else */
-    else {
-      if ((types[9] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
-      if ( H5Tset_precision (types[9], 128) < 0) return ret_value;
-    } /*end else */
+    if ((types[9] = (hid_t_f)H5Tcopy(H5T_STD_REF_OBJ)) < 0) return ret_value;
+    if ((types[10] = (hid_t_f)H5Tcopy(H5T_STD_REF_DSETREG)) < 0) return ret_value;
 
     /*
      * FIND H5T_NATIVE_REAL_C_FLOAT
      */
     if (sizeof(real_C_FLOAT_f) == sizeof(float)) {
-      if ((types[10] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value;
+      if ((types[11] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value;
     } /*end if */
     else if (sizeof(real_C_FLOAT_f) == sizeof(double)) {
-      if ((types[10] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
+      if ((types[11] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
     } /*end if */
 #if H5_SIZEOF_LONG_DOUBLE!=0
     else if (sizeof(real_C_FLOAT_f) == sizeof(long double)) {
-	if ((types[10] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
+	if ((types[11] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
     } /*end else */
 #endif
     /*
      * FIND H5T_NATIVE_REAL_C_DOUBLE
      */
     if (sizeof(real_C_DOUBLE_f) == sizeof(float)) {
-      if ((types[11] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value;
+      if ((types[12] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value;
     } /*end if */
     else if (sizeof(real_C_DOUBLE_f) == sizeof(double)) {
-      if ((types[11] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
+      if ((types[12] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
     } /*end if */
 #if H5_SIZEOF_LONG_DOUBLE!=0
     else if (sizeof(real_C_DOUBLE_f) == sizeof(long double)) {
-	if ((types[11] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
+	if ((types[12] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
     } /*end else */
 #endif
     /*
@@ -229,60 +196,35 @@ h5init_types_c( hid_t_f * types, hid_t_f * floatingtypes, hid_t_f * integertypes
      */
 #if H5_FORTRAN_C_LONG_DOUBLE_IS_UNIQUE!=0
     if (sizeof(real_C_LONG_DOUBLE_f) == sizeof(float)) {
-      if ((types[12] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value;
+      if ((types[13] = (hid_t_f)H5Tcopy(H5T_NATIVE_FLOAT)) < 0) return ret_value;
     } /*end if */
     else if (sizeof(real_C_LONG_DOUBLE_f) == sizeof(double)) {
-      if ((types[12] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
+      if ((types[13] = (hid_t_f)H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
     } /*end if */
 # if H5_FORTRAN_HAVE_C_LONG_DOUBLE!=0
     else if (sizeof(real_C_LONG_DOUBLE_f) == sizeof(long double)) {
       if ( H5_PAC_C_MAX_REAL_PRECISION >= H5_PAC_FC_MAX_REAL_PRECISION) {
-	if ((types[12] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
+	if ((types[13] = (hid_t_f)H5Tcopy(H5T_NATIVE_LDOUBLE)) < 0) return ret_value;
       }
       else {
-	if ((types[12] = H5Tcopy (H5T_NATIVE_FLOAT)) < 0) return ret_value;
-	if ( H5Tset_precision (types[12], 128) < 0) return ret_value;
+	if ((types[13] = H5Tcopy (H5T_NATIVE_FLOAT)) < 0) return ret_value;
+	if ( H5Tset_precision (types[13], 128) < 0) return ret_value;
       }
     }
 # else
-    if ((types[12] = H5Tcopy (H5T_NATIVE_FLOAT)) < 0) return ret_value;
-    if ( H5Tset_precision (types[12], 64) < 0) return ret_value;
+    if ((types[13] = H5Tcopy (H5T_NATIVE_FLOAT)) < 0) return ret_value;
+    if ( H5Tset_precision (types[13], 64) < 0) return ret_value;
 # endif
 #else
-    if ((types[12] = H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
+    if ((types[13] = H5Tcopy(H5T_NATIVE_DOUBLE)) < 0) return ret_value;
 #endif
     /*
      * FIND H5T_NATIVE_B_8
      */
-    if ((types[13] = (hid_t_f)H5Tcopy(H5T_NATIVE_B8))  < 0) return ret_value;
-    if ((types[14] = (hid_t_f)H5Tcopy(H5T_NATIVE_B16)) < 0) return ret_value;
-    if ((types[15] = (hid_t_f)H5Tcopy(H5T_NATIVE_B32)) < 0) return ret_value;
-    if ((types[16] = (hid_t_f)H5Tcopy(H5T_NATIVE_B64)) < 0) return ret_value;
-
-#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0
-     /*
-     * FIND H5T_NATIVE_INTEGER_16
-     */
-    if (sizeof(int_16_f) == sizeof(char)) {
-      if ((types[17] = (hid_t_f)H5Tcopy(H5T_NATIVE_CHAR)) < 0) return ret_value;
-    } /*end if */
-    else if (sizeof(int_16_f) == sizeof(short)) {
-      if ((types[17] = (hid_t_f)H5Tcopy(H5T_NATIVE_SHORT)) < 0) return ret_value;
-    } /*end if */
-    else if (sizeof(int_16_f) == sizeof(int)) {
-      if ((types[17] = (hid_t_f)H5Tcopy(H5T_NATIVE_INT)) < 0) return ret_value;
-    } /*end if */
-    else if (sizeof(int_16_f) == sizeof(long long)) {
-	if ((types[17] = (hid_t_f)H5Tcopy(H5T_NATIVE_LLONG)) < 0) return ret_value;
-    } /*end else */
-    else {
-      if ((types[17] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
-      if ( H5Tset_precision (types[17], 128) < 0) return ret_value;
-    } /*end else */
-#else
-    if ((types[17] = H5Tcopy (H5T_NATIVE_INT)) < 0) return ret_value;
-    if ( H5Tset_precision (types[17], 128) < 0) return ret_value;
-#endif
+    if ((types[14] = (hid_t_f)H5Tcopy(H5T_NATIVE_B8))  < 0) return ret_value;
+    if ((types[15] = (hid_t_f)H5Tcopy(H5T_NATIVE_B16)) < 0) return ret_value;
+    if ((types[16] = (hid_t_f)H5Tcopy(H5T_NATIVE_B32)) < 0) return ret_value;
+    if ((types[17] = (hid_t_f)H5Tcopy(H5T_NATIVE_B64)) < 0) return ret_value;
 
      /*
      * FIND H5T_NATIVE_FLOAT_128