program rdcompd use hdf5 use ISO_C_BINDING implicit none !----------------------------------- ! KIND parameters INTEGER, PARAMETER :: int_k1 = SELECTED_INT_KIND(1) ! This should map to INTEGER*1 on most modern processors INTEGER, PARAMETER :: int_k2 = SELECTED_INT_KIND(4) ! This should map to INTEGER*2 on most modern processors INTEGER, PARAMETER :: int_k4 = SELECTED_INT_KIND(8) ! This should map to INTEGER*4 on most modern processors INTEGER, PARAMETER :: int_k8 = SELECTED_INT_KIND(16) ! This should map to INTEGER*8 on most modern processors INTEGER, PARAMETER :: r_k4 = SELECTED_REAL_KIND(5) ! This should map to REAL*4 on most modern processors INTEGER, PARAMETER :: r_k8 = SELECTED_REAL_KIND(10) ! This should map to REAL*8 on most modern processors !----------------------------------- integer, parameter :: LENGTH=81 !----------------------------------- type sp real(KIND=r_k4) :: wavelength real(KIND=r_k4) :: intensity integer(KIND=int_k1) :: ionization CHARACTER(LEN=22) :: comment end type sp type(sp), target :: wdata(LENGTH) !----------------------------------- ! This is the name of the data file we will read. character (len = *), parameter :: filename = "compd.h5" character (len = *), parameter :: dsetname1 = "He" integer , parameter :: ms_dim0 = LENGTH integer(hid_t) :: file_id, dspace_id, dset_id, memtype, dtype ! Handles integer :: hdferr, i type(c_ptr) :: f_ptr_ms call h5open_f(hdferr) ! open file call h5fopen_f(filename, H5F_ACC_RDONLY_F, file_id, hdferr) ! open dataset call h5dopen_f(file_id, dsetname1, dset_id, hdferr) ! get the datatype call h5dget_type_f(dset_id, dtype, hdferr) call h5tget_native_type_f(dtype, H5T_DIR_ASCEND_F, memtype, hdferr) ! read the data wdata(:)%wavelength=-1; wdata(:)%intensity=-1 wdata(:)%ionization=-1 f_ptr_ms = c_loc(wdata(1)) call h5dread_f(dset_id, memtype, f_ptr_ms, hdferr) do i=1, ms_dim0 print *, wdata(i)%wavelength, wdata(i)%intensity, wdata(i)%ionization, wdata(i)%comment end do ! close and release resources call h5dclose_f(dset_id, hdferr) call h5tclose_f(memtype, hdferr) call h5tclose_f(dtype, hdferr) call h5fclose_f(file_id, hdferr) end program rdcompd