problem to read H5T_STD_I64BE dataset using f90

Hello,

I ran into a problem reading H5T_STD_I64BE data using f90.
Following is a part of a routine code.

···

-------------------------------------------------------------------------------------
INTEGER, parameter:: int8 = selected_int_kind(8)
INTEGER(kind=int8), DIMENSION(:), ALLOCATABLE :: data_out

ALLOCATE(data_out(data_dims(1)))
CALL h5dread_f(dset_id,nat_type_id,data_out,dims,error)
...
--------------------------------------------------------------------------------------
Data set I'm trying to read looks like this:

HDF5 "GMODO_npp_d20100906_t2110510.h5" {
DATASET "/All_Data/VIIRS-MOD-GEO_All/MidTime" {
    DATATYPE H5T_STD_I64BE
    DATASPACE SIMPLE { ( 48 ) / ( H5S_UNLIMITED ) }
    DATA {
    (0): 1662498685374717, 1662498687161083, 1662498688947446,
    (3): 1662498690733806, 1662498692520176, 1662498694306565,
...
--------------------------------------------------------------------------------------
I think the problem I have is a data type. I also tried to read as =>
CALL h5dread_f(dset_id,H5T_NATIVE_INTEGER,data_out,dims,error)
(I know it supports only 32-bit, but I didn't find anything for 64-bit.)

The result is always the same it gives me some weird numbers.
What data type should I use in Fortran 90?

Thanks,
Denis

int8 = selected_int_kind(8) (i.e int range 10^8) will not be big enough to hold the numbers you are trying to read, try selected_int_kind(15) which should give you an 8 byte integer.

···

On Tue, 04 Oct 2011 09:55:48 -0500, Denis wrote:

Hello,

I ran into a problem reading H5T_STD_I64BE data using f90.
Following is a part of a routine code.

-------------------------------------------------------------------------------------
INTEGER, parameter:: int8 = selected_int_kind(8)
INTEGER(kind=int8), DIMENSION(:), ALLOCATABLE :: data_out

ALLOCATE(data_out(data_dims(1)))
CALL h5dread_f(dset_id,nat_type_id,data_out,dims,error)
...

--------------------------------------------------------------------------------------
Data set I'm trying to read looks like this:

HDF5 "GMODO_npp_d20100906_t2110510.h5" {
DATASET "/All_Data/VIIRS-MOD-GEO_All/MidTime" {
   DATATYPE H5T_STD_I64BE
   DATASPACE SIMPLE { ( 48 ) / ( H5S_UNLIMITED ) }
   DATA {
   (0): 1662498685374717, 1662498687161083, 1662498688947446,
   (3): 1662498690733806, 1662498692520176, 1662498694306565,
...

--------------------------------------------------------------------------------------
I think the problem I have is a data type. I also tried to read as =>
CALL h5dread_f(dset_id,H5T_NATIVE_INTEGER,data_out,dims,error)
(I know it supports only 32-bit, but I didn't find anything for 64-bit.)

The result is always the same it gives me some weird numbers.
What data type should I use in Fortran 90?

Thanks,
Denis

_______________________________________________
Hdf-forum is for HDF software users discussion.
Hdf-forum@hdfgroup.org
http://mail.hdfgroup.org/mailman/listinfo/hdf-forum_hdfgroup.org

Thank you. You're right, int8 isn't enough. I tried to use int15 and int18.
It gives me the following compiling error (both gfortran and ifortran).

···

-------------------------------------------------------------------------------------------------
In file test2.f90:69
      CALL h5dread_f(dset_id,nat_type_id,data_out,data_dims,error)
                                                                                                                      1
Error: There is no specific subroutine for the generic 'h5dread_f' at (1)
---------------------------------------------------------------------------------------------------

Thanks,
Denis

On 10/4/2011 10:55 AM, brtnfld@hdfgroup.org wrote:

int8 = selected_int_kind(8) (i.e int range 10^8) will not be big enough to hold the numbers you are trying to read, try selected_int_kind(15) which should give you an 8 byte integer.

On Tue, 04 Oct 2011 09:55:48 -0500, Denis wrote:

Hello,

I ran into a problem reading H5T_STD_I64BE data using f90.
Following is a part of a routine code.

-------------------------------------------------------------------------------------

INTEGER, parameter:: int8 = selected_int_kind(8)
INTEGER(kind=int8), DIMENSION(:), ALLOCATABLE :: data_out

ALLOCATE(data_out(data_dims(1)))
CALL h5dread_f(dset_id,nat_type_id,data_out,dims,error)
...

--------------------------------------------------------------------------------------

Data set I'm trying to read looks like this:

HDF5 "GMODO_npp_d20100906_t2110510.h5" {
DATASET "/All_Data/VIIRS-MOD-GEO_All/MidTime" {
   DATATYPE H5T_STD_I64BE
   DATASPACE SIMPLE { ( 48 ) / ( H5S_UNLIMITED ) }
   DATA {
   (0): 1662498685374717, 1662498687161083, 1662498688947446,
   (3): 1662498690733806, 1662498692520176, 1662498694306565,
...

--------------------------------------------------------------------------------------

I think the problem I have is a data type. I also tried to read as =>
CALL h5dread_f(dset_id,H5T_NATIVE_INTEGER,data_out,dims,error)
(I know it supports only 32-bit, but I didn't find anything for 64-bit.)

The result is always the same it gives me some weird numbers.
What data type should I use in Fortran 90?

Thanks,
Denis

_______________________________________________
Hdf-forum is for HDF software users discussion.
Hdf-forum@hdfgroup.org
http://mail.hdfgroup.org/mailman/listinfo/hdf-forum_hdfgroup.org

_______________________________________________
Hdf-forum is for HDF software users discussion.
Hdf-forum@hdfgroup.org
http://mail.hdfgroup.org/mailman/listinfo/hdf-forum_hdfgroup.org

--
___________________________________________________________
Denis Botambekov
University of Wisconsin-Madison
Cooperative Institute for Meteorological Satellite Studies
1225 W. Dayton St., Room 425
Madison, WI, 53706
Phone: (608) 263-1067

You will have to compile hdf5 so that 8 byte integers are the default integer type ( FCFLAGS = : -i8 with intel, fdefault-integer-8 with gfortran). In the next release this requirement will be removed and, additionally, you will be able to associated the KIND type with the hdf5 type.

···

On Tue, 04 Oct 2011 14:22:29 -0500, Denis wrote:

Thank you. You're right, int8 isn't enough. I tried to use int15 and int18.
It gives me the following compiling error (both gfortran and ifortran).

-------------------------------------------------------------------------------------------------
In file test2.f90:69
     CALL h5dread_f(dset_id,nat_type_id,data_out,data_dims,error)

                                              1
Error: There is no specific subroutine for the generic 'h5dread_f' at (1)

---------------------------------------------------------------------------------------------------

Thanks,
Denis

On 10/4/2011 10:55 AM, brtnfld@hdfgroup.org wrote:

int8 = selected_int_kind(8) (i.e int range 10^8) will not be big enough to hold the numbers you are trying to read, try selected_int_kind(15) which should give you an 8 byte integer.

On Tue, 04 Oct 2011 09:55:48 -0500, Denis wrote:

Hello,

I ran into a problem reading H5T_STD_I64BE data using f90.
Following is a part of a routine code.

-------------------------------------------------------------------------------------

INTEGER, parameter:: int8 = selected_int_kind(8)
INTEGER(kind=int8), DIMENSION(:), ALLOCATABLE :: data_out

ALLOCATE(data_out(data_dims(1)))
CALL h5dread_f(dset_id,nat_type_id,data_out,dims,error)
...

--------------------------------------------------------------------------------------

Data set I'm trying to read looks like this:

HDF5 "GMODO_npp_d20100906_t2110510.h5" {
DATASET "/All_Data/VIIRS-MOD-GEO_All/MidTime" {
   DATATYPE H5T_STD_I64BE
   DATASPACE SIMPLE { ( 48 ) / ( H5S_UNLIMITED ) }
   DATA {
   (0): 1662498685374717, 1662498687161083, 1662498688947446,
   (3): 1662498690733806, 1662498692520176, 1662498694306565,
...

--------------------------------------------------------------------------------------

I think the problem I have is a data type. I also tried to read as =>
CALL h5dread_f(dset_id,H5T_NATIVE_INTEGER,data_out,dims,error)
(I know it supports only 32-bit, but I didn't find anything for 64-bit.)

The result is always the same it gives me some weird numbers.
What data type should I use in Fortran 90?

Thanks,
Denis

_______________________________________________
Hdf-forum is for HDF software users discussion.
Hdf-forum@hdfgroup.org
http://mail.hdfgroup.org/mailman/listinfo/hdf-forum_hdfgroup.org

_______________________________________________
Hdf-forum is for HDF software users discussion.
Hdf-forum@hdfgroup.org
http://mail.hdfgroup.org/mailman/listinfo/hdf-forum_hdfgroup.org

The hdf5 integer default type already has being set as 8 byte.
I also thought that a problem might be that a data set is big endian,
and set a compiler's environment to that. Anyway it gives me the same error.
Do you have any other ideas?

Thanks,
Denis

···

On 10/4/2011 5:56 PM, brtnfld@hdfgroup.org wrote:

You will have to compile hdf5 so that 8 byte integers are the default integer type ( FCFLAGS = : -i8 with intel, fdefault-integer-8 with gfortran). In the next release this requirement will be removed and, additionally, you will be able to associated the KIND type with the hdf5 type.

On Tue, 04 Oct 2011 14:22:29 -0500, Denis wrote:

Thank you. You're right, int8 isn't enough. I tried to use int15 and int18.
It gives me the following compiling error (both gfortran and ifortran).

-------------------------------------------------------------------------------------------------

In file test2.f90:69
     CALL h5dread_f(dset_id,nat_type_id,data_out,data_dims,error)

                                              1
Error: There is no specific subroutine for the generic 'h5dread_f' at (1)

---------------------------------------------------------------------------------------------------

Thanks,
Denis

On 10/4/2011 10:55 AM, brtnfld@hdfgroup.org wrote:

int8 = selected_int_kind(8) (i.e int range 10^8) will not be big enough to hold the numbers you are trying to read, try selected_int_kind(15) which should give you an 8 byte integer.

On Tue, 04 Oct 2011 09:55:48 -0500, Denis wrote:

Hello,

I ran into a problem reading H5T_STD_I64BE data using f90.
Following is a part of a routine code.

-------------------------------------------------------------------------------------

INTEGER, parameter:: int8 = selected_int_kind(8)
INTEGER(kind=int8), DIMENSION(:), ALLOCATABLE :: data_out

ALLOCATE(data_out(data_dims(1)))
CALL h5dread_f(dset_id,nat_type_id,data_out,dims,error)
...

--------------------------------------------------------------------------------------

Data set I'm trying to read looks like this:

HDF5 "GMODO_npp_d20100906_t2110510.h5" {
DATASET "/All_Data/VIIRS-MOD-GEO_All/MidTime" {
   DATATYPE H5T_STD_I64BE
   DATASPACE SIMPLE { ( 48 ) / ( H5S_UNLIMITED ) }
   DATA {
   (0): 1662498685374717, 1662498687161083, 1662498688947446,
   (3): 1662498690733806, 1662498692520176, 1662498694306565,
...

--------------------------------------------------------------------------------------

I think the problem I have is a data type. I also tried to read as =>
CALL h5dread_f(dset_id,H5T_NATIVE_INTEGER,data_out,dims,error)
(I know it supports only 32-bit, but I didn't find anything for 64-bit.)

The result is always the same it gives me some weird numbers.
What data type should I use in Fortran 90?

Thanks,
Denis

_______________________________________________
Hdf-forum is for HDF software users discussion.
Hdf-forum@hdfgroup.org
http://mail.hdfgroup.org/mailman/listinfo/hdf-forum_hdfgroup.org

_______________________________________________
Hdf-forum is for HDF software users discussion.
Hdf-forum@hdfgroup.org
http://mail.hdfgroup.org/mailman/listinfo/hdf-forum_hdfgroup.org

_______________________________________________
Hdf-forum is for HDF software users discussion.
Hdf-forum@hdfgroup.org
http://mail.hdfgroup.org/mailman/listinfo/hdf-forum_hdfgroup.org

--
___________________________________________________________
Denis Botambekov
University of Wisconsin-Madison
Cooperative Institute for Meteorological Satellite Studies
1225 W. Dayton St., Room 425
Madison, WI, 53706
Phone: (608) 263-1067

If it can not find the subroutine interface for h5dread_f then that has nothing to do with the data; it's not finding the correct interface for h5dread_f because the arguments do match the available interfaces. The signature for h5dread_f is

       SUBROUTINE h5dread_f(dset_id, mem_type_id, buf, dims, hdferr)

             INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier
             INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier
             INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims
             INTEGER, INTENT(INOUT), DIMENSION(...up to rank 7...) :: buf
             INTEGER, INTENT(OUT) :: hdferr

Is this how you declared your variable types in:

CALL h5dread_f(dset_id,nat_type_id,data_out,data_dims,error)

Notice if you pass an 8 byte integer, but the library has default 4 byte integers then it will not find the correct interface.

···

On Wed, 05 Oct 2011 14:24:09 -0500, Denis wrote:

The hdf5 integer default type already has being set as 8 byte.
I also thought that a problem might be that a data set is big endian,
and set a compiler's environment to that. Anyway it gives me the same error.
Do you have any other ideas?

Thanks,
Denis

On 10/4/2011 5:56 PM, brtnfld@hdfgroup.org wrote:

You will have to compile hdf5 so that 8 byte integers are the default integer type ( FCFLAGS = : -i8 with intel, fdefault-integer-8 with gfortran). In the next release this requirement will be removed and, additionally, you will be able to associated the KIND type with the hdf5 type.

On Tue, 04 Oct 2011 14:22:29 -0500, Denis wrote:

Thank you. You're right, int8 isn't enough. I tried to use int15 and int18.
It gives me the following compiling error (both gfortran and ifortran).

-------------------------------------------------------------------------------------------------

In file test2.f90:69
     CALL h5dread_f(dset_id,nat_type_id,data_out,data_dims,error)

                                              1
Error: There is no specific subroutine for the generic 'h5dread_f' at (1)

---------------------------------------------------------------------------------------------------

Thanks,
Denis

On 10/4/2011 10:55 AM, brtnfld@hdfgroup.org wrote:

int8 = selected_int_kind(8) (i.e int range 10^8) will not be big enough to hold the numbers you are trying to read, try selected_int_kind(15) which should give you an 8 byte integer.

On Tue, 04 Oct 2011 09:55:48 -0500, Denis wrote:

Hello,

I ran into a problem reading H5T_STD_I64BE data using f90.
Following is a part of a routine code.

-------------------------------------------------------------------------------------

INTEGER, parameter:: int8 = selected_int_kind(8)
INTEGER(kind=int8), DIMENSION(:), ALLOCATABLE :: data_out

ALLOCATE(data_out(data_dims(1)))
CALL h5dread_f(dset_id,nat_type_id,data_out,dims,error)
...

--------------------------------------------------------------------------------------

Data set I'm trying to read looks like this:

HDF5 "GMODO_npp_d20100906_t2110510.h5" {
DATASET "/All_Data/VIIRS-MOD-GEO_All/MidTime" {
   DATATYPE H5T_STD_I64BE
   DATASPACE SIMPLE { ( 48 ) / ( H5S_UNLIMITED ) }
   DATA {
   (0): 1662498685374717, 1662498687161083, 1662498688947446,
   (3): 1662498690733806, 1662498692520176, 1662498694306565,
...

--------------------------------------------------------------------------------------

I think the problem I have is a data type. I also tried to read as =>
CALL h5dread_f(dset_id,H5T_NATIVE_INTEGER,data_out,dims,error)
(I know it supports only 32-bit, but I didn't find anything for 64-bit.)

The result is always the same it gives me some weird numbers.
What data type should I use in Fortran 90?

Thanks,
Denis

_______________________________________________
Hdf-forum is for HDF software users discussion.
Hdf-forum@hdfgroup.org
http://mail.hdfgroup.org/mailman/listinfo/hdf-forum_hdfgroup.org

_______________________________________________
Hdf-forum is for HDF software users discussion.
Hdf-forum@hdfgroup.org
http://mail.hdfgroup.org/mailman/listinfo/hdf-forum_hdfgroup.org

_______________________________________________
Hdf-forum is for HDF software users discussion.
Hdf-forum@hdfgroup.org
http://mail.hdfgroup.org/mailman/listinfo/hdf-forum_hdfgroup.org

Sorry, I might didn't explain a problem clearly. Here it is.
The data I'm trying to read with f90 is 64-bit integer array. By default in f90 integer is 4-byte.
As soon as I declare data_out array as (kind=8) the call statement starts to cause an error while compiling (see below).
When I changed data_out to (kind=4) it compiles and reads the data OK (I checked on the other data set).
Here is a part of code.

···

-----
! Declare
    CHARACTER(LEN=*), PARAMETER :: infile = 'GMODO_npp_d20100906_t2110510.h5'
    CHARACTER(LEN=*), PARAMETER :: dsetname = 'All_Data/VIIRS-MOD-GEO_All/MidTime'
    INTEGER(HID_T) :: file_id
    INTEGER(HID_T) :: dset_id
    INTEGER(HID_T) :: dtype_id
    INTEGER(HID_T) :: nat_type_id
    INTEGER(HID_T) :: dspace_id
    INTEGER :: error
    INTEGER(HSIZE_T), DIMENSION(1) :: data_dims,max_dims
    INTEGER(kind=8), DIMENSION(:), ALLOCATABLE :: data_out

! read data set
      CALL h5dread_f(dset_id,nat_type_id,data_out,data_dims,error)
-----
Here is an error when I declare 8 byte integer.
-----
In file test2.f90:70
      CALL h5dread_f(dset_id,nat_type_id,data_out,data_dims,error)
                                                                                                                       1
Error: There is no specific subroutine for the generic 'h5dread_f' at (1)
-----
By default, in the hdf5 libraries, integer is set as 8-byte.
Any ideas?

Thanks,
Denis

On 10/5/2011 5:26 PM, brtnfld@hdfgroup.org wrote:

If it can not find the subroutine interface for h5dread_f then that has nothing to do with the data; it's not finding the correct interface for h5dread_f because the arguments do match the available interfaces. The signature for h5dread_f is

      SUBROUTINE h5dread_f(dset_id, mem_type_id, buf, dims, hdferr)

            INTEGER(HID_T), INTENT(IN) :: dset_id ! Dataset identifier
            INTEGER(HID_T), INTENT(IN) :: mem_type_id ! Memory datatype identifier
            INTEGER(HSIZE_T), INTENT(IN), DIMENSION(*) :: dims
            INTEGER, INTENT(INOUT), DIMENSION(...up to rank 7...) :: buf
            INTEGER, INTENT(OUT) :: hdferr

Is this how you declared your variable types in:

CALL h5dread_f(dset_id,nat_type_id,data_out,data_dims,error)

Notice if you pass an 8 byte integer, but the library has default 4 byte integers then it will not find the correct interface.

On Wed, 05 Oct 2011 14:24:09 -0500, Denis wrote:

The hdf5 integer default type already has being set as 8 byte.
I also thought that a problem might be that a data set is big endian,
and set a compiler's environment to that. Anyway it gives me the same error.
Do you have any other ideas?

Thanks,
Denis

On 10/4/2011 5:56 PM, brtnfld@hdfgroup.org wrote:

You will have to compile hdf5 so that 8 byte integers are the default integer type ( FCFLAGS = : -i8 with intel, fdefault-integer-8 with gfortran). In the next release this requirement will be removed and, additionally, you will be able to associated the KIND type with the hdf5 type.

On Tue, 04 Oct 2011 14:22:29 -0500, Denis wrote:

Thank you. You're right, int8 isn't enough. I tried to use int15 and int18.
It gives me the following compiling error (both gfortran and ifortran).

-------------------------------------------------------------------------------------------------

In file test2.f90:69
     CALL h5dread_f(dset_id,nat_type_id,data_out,data_dims,error)

                                              1
Error: There is no specific subroutine for the generic 'h5dread_f' at (1)

---------------------------------------------------------------------------------------------------

Thanks,
Denis

On 10/4/2011 10:55 AM, brtnfld@hdfgroup.org wrote:

int8 = selected_int_kind(8) (i.e int range 10^8) will not be big enough to hold the numbers you are trying to read, try selected_int_kind(15) which should give you an 8 byte integer.

On Tue, 04 Oct 2011 09:55:48 -0500, Denis wrote:

Hello,

I ran into a problem reading H5T_STD_I64BE data using f90.
Following is a part of a routine code.

-------------------------------------------------------------------------------------

INTEGER, parameter:: int8 = selected_int_kind(8)
INTEGER(kind=int8), DIMENSION(:), ALLOCATABLE :: data_out

ALLOCATE(data_out(data_dims(1)))
CALL h5dread_f(dset_id,nat_type_id,data_out,dims,error)
...

--------------------------------------------------------------------------------------

Data set I'm trying to read looks like this:

HDF5 "GMODO_npp_d20100906_t2110510.h5" {
DATASET "/All_Data/VIIRS-MOD-GEO_All/MidTime" {
   DATATYPE H5T_STD_I64BE
   DATASPACE SIMPLE { ( 48 ) / ( H5S_UNLIMITED ) }
   DATA {
   (0): 1662498685374717, 1662498687161083, 1662498688947446,
   (3): 1662498690733806, 1662498692520176, 1662498694306565,
...

--------------------------------------------------------------------------------------

I think the problem I have is a data type. I also tried to read as =>
CALL h5dread_f(dset_id,H5T_NATIVE_INTEGER,data_out,dims,error)
(I know it supports only 32-bit, but I didn't find anything for 64-bit.)

The result is always the same it gives me some weird numbers.
What data type should I use in Fortran 90?

Thanks,
Denis

_______________________________________________
Hdf-forum is for HDF software users discussion.
Hdf-forum@hdfgroup.org
http://mail.hdfgroup.org/mailman/listinfo/hdf-forum_hdfgroup.org

_______________________________________________
Hdf-forum is for HDF software users discussion.
Hdf-forum@hdfgroup.org
http://mail.hdfgroup.org/mailman/listinfo/hdf-forum_hdfgroup.org

_______________________________________________
Hdf-forum is for HDF software users discussion.
Hdf-forum@hdfgroup.org
http://mail.hdfgroup.org/mailman/listinfo/hdf-forum_hdfgroup.org

_______________________________________________
Hdf-forum is for HDF software users discussion.
Hdf-forum@hdfgroup.org
http://mail.hdfgroup.org/mailman/listinfo/hdf-forum_hdfgroup.org