program hdf5_global_attr_test

  use hdf5
  
	implicit none
	
  character(len=255)    ::  h5file
  character(len=255)    ::  grp_name, attr_name
  integer(hid_t)        ::  h5id, grpid, dspid
  integer(hid_t)        ::  h5status
  integer(hid_t)        ::  attrid
  
  integer(hsize_t), dimension(1)  ::  h5dims1

!   --- create "broken" HDF5 file
  h5file = "scalar_attr.h5"
  call h5open_f(h5status)
  if (h5status < 0) then
    print *, "ERROR: Unable to initialize HDF5 library: ", h5status
    stop
  end if

  call h5fcreate_f(h5file, H5F_ACC_EXCL_F, h5id, h5status)
  if (h5status < 0) then
    print *, "ERROR: Unable to create HDF5 file: ", h5file
    print *, "Status: ", h5status
    stop
  end if
  
  grp_name = "/"
  call h5gopen_f(h5id, grp_name, grpid, h5status)
  if (h5status < 0) then 
    print *, "ERROR: Unable to open root group: ", h5status
    stop
  end if
    
  attr_name = "scalar_attr"
  call h5screate_f(H5S_SCALAR_F, dspid, h5status)
  if (h5status < 0) then
    print *, "ERROR: Unable to create dataspace for "//trim(attr_name)//" attribute: ", h5status
    stop
  end if
  
  call h5acreate_f(grpid, attr_name, H5T_NATIVE_INTEGER, dspid, attrid, h5status)
  if (h5status < 0) then
    print *, "ERROR: Unable to create "//trim(attr_name)//" attribute: ", h5status
    stop
  end if
  
  call h5awrite_f(attrid, H5T_NATIVE_INTEGER, 1, h5dims1, h5status)
  if (h5status < 0) then
    print *, "ERROR: Unable to write "//trim(attr_name)//" attribute: ", h5status
    stop
  end if

  call h5aclose_f(attrid, h5status)
  if (h5status < 0) then
    print *, "ERROR: Unable to close "//trim(attr_name)//" attribute: ", h5status
    stop
  end if
  
  call h5sclose_f(dspid, h5status)
  if (h5status < 0) then
    print *, "ERROR: Unable to close "//trim(attr_name)//" dataspace: ", h5status
    stop
  end if
  
  call h5gclose_f(grpid, h5status)
  if (h5status /= 0) then
    print *, "ERROR: Unable to close root group: ", h5status
    stop
  end if
  
  call h5fclose_f(h5id, h5status)
  if (h5status < 0) then
    print *, "ERROR: Unable to close L2 file: ", h5file
    print *, "Status: ", h5status
    stop
  end if
    
  call h5close_f(h5status)
  if (h5status < 0) then
    print *, "ERROR: Unable to close HDF5 library: ", h5status
    stop
  end if
  
! -- create the working HDF5 file
  h5file = "array_attr.h5"
  call h5open_f(h5status)
  if (h5status < 0) then
    print *, "ERROR: Unable to initialize HDF5 library: ", h5status
    stop
  end if

  call h5fcreate_f(h5file, H5F_ACC_EXCL_F, h5id, h5status)
  if (h5status < 0) then
    print *, "ERROR: Unable to create HDF5 file: ", h5file
    print *, "Status: ", h5status
    stop
  end if
  
  grp_name = "/"
  call h5gopen_f(h5id, grp_name, grpid, h5status)
  if (h5status < 0) then 
    print *, "ERROR: Unable to open root group: ", h5status
    stop
  end if
    
  attr_name = "array_attr"
  h5dims1 = (/1/)
  call h5screate_simple_f(1, h5dims1, dspid, h5status)
  if (h5status < 0) then
    print *, "ERROR: Unable to create dataspace for "//trim(attr_name)//" attribute: ", h5status
    stop
  end if
  
  call h5acreate_f(grpid, attr_name, H5T_NATIVE_INTEGER, dspid, attrid, h5status)
  if (h5status < 0) then
    print *, "ERROR: Unable to create "//trim(attr_name)//" attribute: ", h5status
    stop
  end if
  
  call h5awrite_f(attrid, H5T_NATIVE_INTEGER, 1, h5dims1, h5status)
  if (h5status < 0) then
    print *, "ERROR: Unable to write "//trim(attr_name)//" attribute: ", h5status
    stop
  end if

  call h5aclose_f(attrid, h5status)
  if (h5status < 0) then
    print *, "ERROR: Unable to close "//trim(attr_name)//" attribute: ", h5status
    stop
  end if
  
  call h5sclose_f(dspid, h5status)
  if (h5status < 0) then
    print *, "ERROR: Unable to close "//trim(attr_name)//" dataspace: ", h5status
    stop
  end if
  
  call h5gclose_f(grpid, h5status)
  if (h5status /= 0) then
    print *, "ERROR: Unable to close root group: ", h5status
    stop
  end if
  
  call h5fclose_f(h5id, h5status)
  if (h5status < 0) then
    print *, "ERROR: Unable to close L2 file: ", h5file
    print *, "Status: ", h5status
    stop
  end if
    
  call h5close_f(h5status)
  if (h5status < 0) then
    print *, "ERROR: Unable to close HDF5 library: ", h5status
    stop
  end if

end program hdf5_global_attr_test