diff options
| -rw-r--r-- | fortran/src/H5Pff.F90 | 14 | ||||
| -rw-r--r-- | fortran/src/H5_f.c | 236 | ||||
| -rw-r--r-- | fortran/src/H5_ff.F90 | 38 | ||||
| -rw-r--r-- | fortran/src/H5f90global.F90 | 43 | ||||
| -rw-r--r-- | fortran/src/H5match_types.c | 40 | ||||
| -rw-r--r-- | fortran/test/fortranlib_test_F03.F90 | 2 | ||||
| -rw-r--r-- | fortran/test/tH5T_F03.F90 | 42 |
7 files changed, 181 insertions, 234 deletions
diff --git a/fortran/src/H5Pff.F90 b/fortran/src/H5Pff.F90 index 532ecc6..6ba5aeb 100644 --- a/fortran/src/H5Pff.F90 +++ b/fortran/src/H5Pff.F90 @@ -6397,18 +6397,18 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr) !! SUBROUTINE h5pget_fill_value_f(prp_id, type_id, fillvalue, hdferr) !! INTEGER(HID_T), INTENT(IN) :: prp_id !! INTEGER(HID_T), INTENT(IN) :: type_id -!! TYPE(C_PTR) , INTENT(OUT) :: fillvalue +!! TYPE(C_PTR) :: fillvalue !! INTEGER , INTENT(OUT) :: hdferr !***** SUBROUTINE h5pget_fill_value_ptr(prp_id, type_id, fillvalue, hdferr) IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier - INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier of - ! of fillvalue datatype - ! (in memory) - TYPE(C_PTR), INTENT(OUT) :: fillvalue ! Fillvalue - INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier of + ! of fillvalue datatype + ! (in memory) + TYPE(C_PTR) :: fillvalue ! Fillvalue + INTEGER , INTENT(OUT) :: hdferr ! Error code hdferr = h5pget_fill_value_c(prp_id, type_id, fillvalue) 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 diff --git a/fortran/src/H5_ff.F90 b/fortran/src/H5_ff.F90 index 169864f..9717d17 100644 --- a/fortran/src/H5_ff.F90 +++ b/fortran/src/H5_ff.F90 @@ -379,27 +379,24 @@ CONTAINS IMPLICIT NONE INTEGER, INTENT(IN) :: ikind INTEGER, INTENT(IN) :: flag -#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0 - INTEGER :: Fortran_INTEGER_16 - Fortran_INTEGER_16=SELECTED_INT_KIND(36) !should map to INTEGER*16 on most modern processors -#endif - - + INTEGER :: i !***** + +!#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0 +! ! (1) The array index assumes INTEGER*16 the last integer in the series, and +! ! (2) it should map to INTEGER*16 on most modern processors +! H5T_NATIVE_INTEGER_KIND(H5_FORTRAN_NUM_INTEGER_KINDS)=SELECTED_INT_KIND(36) +!#endif + + h5_type = -1 IF(flag.EQ.H5_INTEGER_KIND)THEN - IF(ikind.EQ.Fortran_INTEGER_1)THEN - h5_type = H5T_NATIVE_INTEGER_1 - ELSE IF(ikind.EQ.Fortran_INTEGER_2)THEN - h5_type = H5T_NATIVE_INTEGER_2 - ELSE IF(ikind.EQ.Fortran_INTEGER_4)THEN - h5_type = H5T_NATIVE_INTEGER_4 - ELSE IF(ikind.EQ.Fortran_INTEGER_8)THEN - h5_type = H5T_NATIVE_INTEGER_8 -#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0 - ELSE IF(ikind.EQ.Fortran_INTEGER_16)THEN - h5_type = H5T_NATIVE_INTEGER_16 -#endif - ENDIF + do_kind: DO i = 1, H5_FORTRAN_NUM_INTEGER_KINDS + IF(ikind.EQ.Fortran_INTEGER_AVAIL_KINDS(i))THEN + !PRINT*,ikind, Fortran_INTEGER_AVAIL_KINDS(i),H5T_NATIVE_INTEGER_KIND(i) + h5_type = H5T_NATIVE_INTEGER_KIND(i) + EXIT do_kind + ENDIF + END DO do_kind ELSE IF(flag.EQ.H5_REAL_KIND)THEN IF(ikind.EQ.KIND(1.0_C_FLOAT))THEN h5_type = H5T_NATIVE_REAL_C_FLOAT @@ -414,9 +411,6 @@ CONTAINS ELSE h5_type = H5T_NATIVE_FLOAT_128 #endif -#else - ELSE - h5_type = -1 #endif ENDIF ENDIF diff --git a/fortran/src/H5f90global.F90 b/fortran/src/H5f90global.F90 index af0a000..aef3e4d 100644 --- a/fortran/src/H5f90global.F90 +++ b/fortran/src/H5f90global.F90 @@ -115,8 +115,11 @@ MODULE H5GLOBAL H5T_STD_U16BE, & H5T_STD_U16LE, & H5T_STD_U32BE - - INTEGER(HID_T) :: H5T_NATIVE_INTEGER_16 ! NEED IFDEF -MSB- + + INTEGER, PARAMETER :: NUM_NATIVE_INTEGER_KIND = 5 + ! INTEGER*1, INTEGER*2, INTEGER*4, INTEGER*8, INTEGER*16 + INTEGER(HID_T), DIMENSION(1:NUM_NATIVE_INTEGER_KIND) :: H5T_NATIVE_INTEGER_KIND + INTEGER(HID_T) :: H5T_NATIVE_FLOAT_128 ! NEED IFDEF -MSB- ! NOTE: Splitting the line since the Fortran 95 standard limits the number of @@ -144,24 +147,24 @@ MODULE H5GLOBAL INTEGER(HID_T), DIMENSION(PREDEF_TYPES_LEN) :: predef_types - EQUIVALENCE (predef_types(1), H5T_NATIVE_INTEGER) - EQUIVALENCE (predef_types(2), H5T_NATIVE_REAL) - EQUIVALENCE (predef_types(3), H5T_NATIVE_DOUBLE) - EQUIVALENCE (predef_types(4), H5T_NATIVE_CHARACTER) - EQUIVALENCE (predef_types(5), H5T_STD_REF_OBJ) - EQUIVALENCE (predef_types(6), H5T_STD_REF_DSETREG) - EQUIVALENCE (predef_types(7), H5T_NATIVE_INTEGER_1) - EQUIVALENCE (predef_types(8), H5T_NATIVE_INTEGER_2) - EQUIVALENCE (predef_types(9), H5T_NATIVE_INTEGER_4) - EQUIVALENCE (predef_types(10), H5T_NATIVE_INTEGER_8) - EQUIVALENCE (predef_types(11), H5T_NATIVE_REAL_C_FLOAT) - EQUIVALENCE (predef_types(12), H5T_NATIVE_REAL_C_DOUBLE) - EQUIVALENCE (predef_types(13), H5T_NATIVE_REAL_C_LONG_DOUBLE) - EQUIVALENCE (predef_types(14), H5T_NATIVE_B8 ) - EQUIVALENCE (predef_types(15), H5T_NATIVE_B16) - EQUIVALENCE (predef_types(16), H5T_NATIVE_B32) - EQUIVALENCE (predef_types(17), H5T_NATIVE_B64) - EQUIVALENCE (predef_types(18), H5T_NATIVE_INTEGER_16) ! ADDED NEW TYPE -MSB- + EQUIVALENCE (predef_types(1), H5T_NATIVE_INTEGER_KIND(1)) + EQUIVALENCE (predef_types(2), H5T_NATIVE_INTEGER_KIND(2)) + EQUIVALENCE (predef_types(3), H5T_NATIVE_INTEGER_KIND(3)) + EQUIVALENCE (predef_types(4), H5T_NATIVE_INTEGER_KIND(4)) + EQUIVALENCE (predef_types(5), H5T_NATIVE_INTEGER_KIND(5)) + EQUIVALENCE (predef_types(6), H5T_NATIVE_INTEGER) + EQUIVALENCE (predef_types(7), H5T_NATIVE_REAL) + EQUIVALENCE (predef_types(8), H5T_NATIVE_DOUBLE) + EQUIVALENCE (predef_types(9), H5T_NATIVE_CHARACTER) + EQUIVALENCE (predef_types(10), H5T_STD_REF_OBJ) + EQUIVALENCE (predef_types(11), H5T_STD_REF_DSETREG) + EQUIVALENCE (predef_types(12), H5T_NATIVE_REAL_C_FLOAT) + EQUIVALENCE (predef_types(13), H5T_NATIVE_REAL_C_DOUBLE) + EQUIVALENCE (predef_types(14), H5T_NATIVE_REAL_C_LONG_DOUBLE) + EQUIVALENCE (predef_types(15), H5T_NATIVE_B8 ) + EQUIVALENCE (predef_types(16), H5T_NATIVE_B16) + EQUIVALENCE (predef_types(17), H5T_NATIVE_B32) + EQUIVALENCE (predef_types(18), H5T_NATIVE_B64) EQUIVALENCE (predef_types(19), H5T_NATIVE_FLOAT_128) ! ADDED NEW TYPE -MSB- INTEGER(HID_T), DIMENSION(FLOATING_TYPES_LEN) :: floating_types diff --git a/fortran/src/H5match_types.c b/fortran/src/H5match_types.c index 98128db..6f5af49 100644 --- a/fortran/src/H5match_types.c +++ b/fortran/src/H5match_types.c @@ -100,7 +100,7 @@ initFfile(void) ! access to either file, you may request a copy from help@hdfgroup.org. *\n\ ! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n\ !\n!\n\ -! This file is automatically generated and contains HDF5 Fortran90 type definitions.\n!\n\ +! This file is automatically generated by H5match_types.c and contains HDF5 Fortran90 type definitions.\n!\n\ MODULE H5FORTRAN_TYPES\n\ USE ISO_C_BINDING\n\ !\n\ @@ -175,6 +175,11 @@ int main(void) H5_FORTRAN_NUM_INTEGER_KINDS = (int)(sizeof(IntKinds)/sizeof(IntKinds[0])); H5_FORTRAN_NUM_REAL_KINDS = (int)(sizeof(RealKinds)/sizeof(RealKinds[0])); + + + fprintf(fort_header," INTEGER, PARAMETER :: H5_FORTRAN_NUM_INTEGER_KINDS = %d\n", H5_FORTRAN_NUM_INTEGER_KINDS); + + for(i=0;i< H5_FORTRAN_NUM_INTEGER_KINDS;i++) { if(sizeof(long long) == IntKinds_SizeOf[i]) writeTypedef("int", "long long", IntKinds[i]); @@ -258,7 +263,7 @@ int main(void) /* haddr_t */ for(i=0;i< H5_FORTRAN_NUM_INTEGER_KINDS;i++) { if(IntKinds_SizeOf[i] == H5_SIZEOF_HADDR_T) { - writeToFiles("int","HADDR_T", "haddr_t_f", H5_SIZEOF_HADDR_T, IntKinds[i]); + writeToFiles("int","HADDR_T", "haddr_t_f", IntKinds[i], IntKinds[i]); break; } if(i == (H5_FORTRAN_NUM_INTEGER_KINDS-1) ) @@ -269,7 +274,7 @@ int main(void) /* hsize_t */ for(i=0;i< H5_FORTRAN_NUM_INTEGER_KINDS;i++) { if(IntKinds_SizeOf[i] == H5_SIZEOF_HSIZE_T) { - writeToFiles("hsize_t","HSIZE_T", "hsize_t_f", H5_SIZEOF_HSIZE_T, IntKinds[i]); + writeToFiles("hsize_t","HSIZE_T", "hsize_t_f", IntKinds[i], IntKinds[i]); break; } if(i == (H5_FORTRAN_NUM_INTEGER_KINDS-1) ) @@ -280,7 +285,7 @@ int main(void) /* hssize_t */ for(i=0;i< H5_FORTRAN_NUM_INTEGER_KINDS;i++) { if(IntKinds_SizeOf[i] == H5_SIZEOF_HSSIZE_T) { - writeToFiles("int","HSSIZE_T", "hssize_t_f", H5_SIZEOF_HSSIZE_T, IntKinds[i]); + writeToFiles("int","HSSIZE_T", "hssize_t_f", IntKinds[i], IntKinds[i]); break; } if(i == (H5_FORTRAN_NUM_INTEGER_KINDS-1) ) @@ -291,7 +296,7 @@ int main(void) /* off_t */ for(i=0;i< H5_FORTRAN_NUM_INTEGER_KINDS;i++) { if(IntKinds_SizeOf[i] == H5_SIZEOF_OFF_T) { - writeToFiles("int","OFF_T", "off_t_f", H5_SIZEOF_OFF_T, IntKinds[i]); + writeToFiles("int","OFF_T", "off_t_f", IntKinds[i], IntKinds[i]); break; } if(i == (H5_FORTRAN_NUM_INTEGER_KINDS-1) ) @@ -302,7 +307,7 @@ int main(void) /* size_t */ for(i=0;i< H5_FORTRAN_NUM_INTEGER_KINDS;i++) { if(IntKinds_SizeOf[i] == H5_SIZEOF_SIZE_T) { - writeToFiles("size_t","SIZE_T", "size_t_f", H5_SIZEOF_SIZE_T, IntKinds[i]); + writeToFiles("size_t","SIZE_T", "size_t_f", IntKinds[i], IntKinds[i]); break; } if(i == (H5_FORTRAN_NUM_INTEGER_KINDS-1) ) @@ -311,7 +316,7 @@ int main(void) } /* int */ - writeToFiles("int","Fortran_INTEGER", "int_f", H5_FORTRAN_NATIVE_INTEGER_SIZEOF, H5_FORTRAN_NATIVE_INTEGER_KIND); + writeToFiles("int","Fortran_INTEGER", "int_f", H5_FORTRAN_NATIVE_INTEGER_KIND, H5_FORTRAN_NATIVE_INTEGER_KIND); /* int_1, int_2, int_4, int_8 */ @@ -327,16 +332,29 @@ int main(void) FoundIntSize[3] = -1; FoundIntSize[4] = -1; + fprintf(fort_header," INTEGER, DIMENSION(1:%d), PARAMETER :: Fortran_INTEGER_AVAIL_KINDS = (/", H5_FORTRAN_NUM_INTEGER_KINDS); + for(i=0;i<H5_FORTRAN_NUM_INTEGER_KINDS;i++) { FoundIntSize[i] = (int)IntKinds[i]; FoundIntSizeKind[i] = (int)IntKinds_SizeOf[i]; /* writeToFiles("int",chrA, chrB, FoundIntSize[i], FoundIntSizeKind[i]); */ + fprintf(fort_header,"%d",(int)IntKinds[i]); + if(i==H5_FORTRAN_NUM_INTEGER_KINDS-1) { + fprintf(fort_header,"/)\n"); + } else { + fprintf(fort_header,","); + } + } + + + + for(i=0;i<H5_FORTRAN_NUM_INTEGER_KINDS;i++) { if( FoundIntSize[i] > 0) /* Found the integer type */ { - sprintf(chrA, "Fortran_INTEGER_%d", FoundIntSize[i]); + sprintf(chrA, "Fortran_INTEGER_KINDS_%d", FoundIntSizeKind[i]); sprintf(chrB, "int_%d_f", FoundIntSize[i]); writeToFiles("int",chrA, chrB, FoundIntSize[i], FoundIntSizeKind[i]); } @@ -347,7 +365,7 @@ int main(void) { if( FoundIntSize[j] > 0) /* Found the next highest */ { - sprintf(chrA, "Fortran_INTEGER_%d", (-1)*FoundIntSize[i]); + sprintf(chrA, "Fortran_INTEGER_KINDS_%d", (-1)*FoundIntSizeKind[i]); sprintf(chrB, "int_%d_f", (-1)*FoundIntSize[i]); writeToFiles("int",chrA, chrB, FoundIntSize[j], FoundIntSizeKind[j]); flag = 1; @@ -360,7 +378,7 @@ int main(void) { if( FoundIntSize[j] > 0) /* Found the next lowest */ { - sprintf(chrA, "Fortran_INTEGER_%d", (-1)*FoundIntSize[i]); + sprintf(chrA, "Fortran_INTEGER_KINDS_%d", (-1)*FoundIntSizeKind[i]); sprintf(chrB, "int_%d_f", (-1)*FoundIntSize[i]); writeToFiles("int",chrA, chrB, FoundIntSize[j], FoundIntSizeKind[j]); flag = 1; @@ -391,7 +409,7 @@ int main(void) /* hid_t */ for(i=0;i< H5_FORTRAN_NUM_INTEGER_KINDS;i++) { if(IntKinds_SizeOf[i] == H5_SIZEOF_HID_T) { - writeToFiles("int","HID_T", "hid_t_f", H5_SIZEOF_HID_T, IntKinds[i]); + writeToFiles("int","HID_T", "hid_t_f", IntKinds[i], IntKinds[i]); break; } if(i == (H5_FORTRAN_NUM_INTEGER_KINDS-1) ) diff --git a/fortran/test/fortranlib_test_F03.F90 b/fortran/test/fortranlib_test_F03.F90 index 070cd73..5f5fd2d 100644 --- a/fortran/test/fortranlib_test_F03.F90 +++ b/fortran/test/fortranlib_test_F03.F90 @@ -131,7 +131,7 @@ PROGRAM fortranlibtest_F03 ret_total_error = 0 CALL test_array_bkg(ret_total_error) - CALL write_test_status(ret_total_error, ' Testing Partial I/O of Array Fields in Compound Datatype FunctionalityT', total_error) + CALL write_test_status(ret_total_error, ' Testing Partial I/O of Array Fields in Compound Datatype Functionality', total_error) ret_total_error = 0 CALL test_genprop_class_callback(ret_total_error) diff --git a/fortran/test/tH5T_F03.F90 b/fortran/test/tH5T_F03.F90 index 6ddded4..a9148a7 100644 --- a/fortran/test/tH5T_F03.F90 +++ b/fortran/test/tH5T_F03.F90 @@ -1144,33 +1144,33 @@ END SUBROUTINE test_array_compound_atomic ! ! Read data back into an integer size that is larger then the original size used for ! writing the data - f_ptr = C_LOC(data_out_i1) + f_ptr = C_LOC(data_out_i1(1)) CALL h5dread_f(dset_id1, h5kind_to_type(int_kind_1,H5_INTEGER_KIND), f_ptr, error) CALL check("h5dread_f",error, total_error) - f_ptr = C_LOC(data_out_i4) + f_ptr = C_LOC(data_out_i4(1)) CALL h5dread_f(dset_id4, h5kind_to_type(int_kind_4,H5_INTEGER_KIND), f_ptr, error) CALL check("h5dread_f",error, total_error) - f_ptr = C_LOC(data_out_i8) + f_ptr = C_LOC(data_out_i8(1)) CALL h5dread_f(dset_id8, h5kind_to_type(int_kind_8,H5_INTEGER_KIND), f_ptr, error) CALL check("h5dread_f",error, total_error) - f_ptr = C_LOC(data_out_i16) + f_ptr = C_LOC(data_out_i16(1)) CALL h5dread_f(dset_id16, h5kind_to_type(int_kind_16,H5_INTEGER_KIND), f_ptr, error) CALL check("h5dread_f",error, total_error) #if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0 - f_ptr = C_LOC(data_out_i32) + f_ptr = C_LOC(data_out_i32(1)) CALL h5dread_f(dset_id32, h5kind_to_type(int_kind_32,H5_INTEGER_KIND), f_ptr, error) CALL check("h5dread_f",error, total_error) #endif - f_ptr = C_LOC(data_out_r) + f_ptr = C_LOC(data_out_r(1)) CALL h5dread_f(dset_idr, H5T_NATIVE_REAL, f_ptr, error) CALL check("h5dread_f",error, total_error) - f_ptr = C_LOC(data_out_r7) + f_ptr = C_LOC(data_out_r7(1)) CALL h5dread_f(dset_idr4, h5kind_to_type(real_kind_7,H5_REAL_KIND), f_ptr, error) CALL check("h5dread_f",error, total_error) - f_ptr = C_LOC(data_out_r15) + f_ptr = C_LOC(data_out_r15(1)) CALL h5dread_f(dset_idr8, h5kind_to_type(real_kind_15,H5_REAL_KIND), f_ptr, error) CALL check("h5dread_f",error, total_error) - f_ptr = C_LOC(data_out_r31) + f_ptr = C_LOC(data_out_r31(1)) CALL h5dread_f(dset_idr16, h5kind_to_type(real_kind_31,H5_REAL_KIND), f_ptr, error) CALL check("h5dread_f",error, total_error) DO i = 1, 4 @@ -2000,7 +2000,7 @@ SUBROUTINE t_regref(total_error) CALL h5dcreate_f(file,dataset2, H5T_STD_I8LE, space, dset2, error) CALL check("h5dcreate_f",error, total_error) f_ptr = C_LOC(wdata2(1,1)) - CALL h5dwrite_f(dset2, H5T_NATIVE_INTEGER_1, f_ptr, error) + CALL h5dwrite_f(dset2, H5T_NATIVE_INTEGER_KIND(1), f_ptr, error) CALL check("h5dwrite_f",error, total_error) ! ! Create reference to a list of elements in dset2. @@ -2112,7 +2112,7 @@ SUBROUTINE t_regref(total_error) CALL check("h5screate_simple_f",error, total_error) f_ptr = C_LOC(rdata2(1)(1:1)) - CALL h5dread_f( dset2, H5T_NATIVE_INTEGER_1, f_ptr, error, memspace, space) + CALL h5dread_f( dset2, H5T_NATIVE_INTEGER_KIND(1), f_ptr, error, memspace, space) CALL check("H5Dread_f",error, total_error) CALL verify("h5dread_f",rdata2(1)(1:npoints),TRIM(chrref_correct(i)), total_error) @@ -2886,33 +2886,23 @@ SUBROUTINE setup_buffer(data_in, line_lengths, char_type) CHARACTER(len=10), DIMENSION(:) :: data_in INTEGER(size_t), DIMENSION(:) :: line_lengths - INTEGER, DIMENSION(1:3) :: letters - CHARACTER(LEN=3) :: lets + CHARACTER(LEN=3) :: lets = 'abc' CHARACTER(KIND=C_CHAR,LEN=*) :: char_type - CHARACTER(KIND=C_CHAR,LEN=1) :: char_tmp - INTEGER :: i, j, n, ff + INTEGER :: i, j, n - ! Convert the letters and special character to integers - lets = 'abc' - - READ(lets,'(3A1)') letters - READ(char_type,'(A1)') ff n = SIZE(data_in) j = 1 DO i=1,n-1 IF( j .EQ. 4 )THEN - WRITE(char_tmp,'(A1)') ff - data_in(i:i) = char_tmp + data_in(i:i) = char_type(1:1) ELSE - WRITE(char_tmp,'(A1)') letters(j) - data_in(i:i) = char_tmp + data_in(i:i) = lets(j:j) ENDIF line_lengths(i) = LEN_TRIM(data_in(i)) j = j + 1 IF( j .EQ. 5 ) j = 1 END DO - WRITE(char_tmp,'(A1)') ff - data_in(n:n) = char_tmp + data_in(n:n) = char_type(1:1) line_lengths(n) = 1 END SUBROUTINE setup_buffer |