keep order of objects in groups

Author: MarDiehl

src/HDF5_utilities.f90

@@ -190,49 +190,49 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel)
   logical,          intent(in), optional :: parallel
 
   character      :: m
-  integer(HID_T) :: p_access,p_create
+  integer(HID_T) :: plist_access_id,plist_create_id
   integer :: hdferr
   logical :: exist
 
 
   m = misc_optional(mode,'r')
 
-  call H5Pcreate_f(H5P_FILE_CREATE_F, p_create, hdferr)
+  call H5Pcreate_f(H5P_FILE_CREATE_F,plist_create_id,hdferr)
   call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
-  call H5Pset_link_creation_order_f(p_create, ior(H5P_CRT_ORDER_INDEXED_F,H5P_CRT_ORDER_TRACKED_F), hdferr)
+  call H5Pset_link_creation_order_f(plist_create_id,ior(H5P_CRT_ORDER_INDEXED_F,H5P_CRT_ORDER_TRACKED_F),hdferr)
   call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
 
-  call H5Pcreate_f(H5P_FILE_ACCESS_F, p_access, hdferr)
+  call H5Pcreate_f(H5P_FILE_ACCESS_F, plist_access_id,hdferr)
   call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
 #ifdef PETSC
   if (misc_optional(parallel,.true.)) &
 #if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY)
-    call H5Pset_fapl_mpio_f(p_access, PETSC_COMM_WORLD, MPI_INFO_NULL_F90, hdferr)
+    call H5Pset_fapl_mpio_f(plist_access_id, PETSC_COMM_WORLD, MPI_INFO_NULL_F90, hdferr)
 #else
-    call H5Pset_fapl_mpio_f(p_access, PETSC_COMM_WORLD, MPI_INFO_NULL,     hdferr)
+    call H5Pset_fapl_mpio_f(plist_access_id, PETSC_COMM_WORLD, MPI_INFO_NULL,     hdferr)
 #endif
   call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
 #endif
 
   if     (m == 'w') then
     call H5Fcreate_f(fileName,H5F_ACC_TRUNC_F,HDF5_openFile,hdferr,&
-                     access_prp=p_access,creation_prp=p_create)
+                     access_prp=plist_access_id,creation_prp=plist_create_id)
     call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
   elseif (m == 'a') then
-    call H5Fopen_f(fileName,H5F_ACC_RDWR_F,HDF5_openFile,hdferr,access_prp=p_access)
+    call H5Fopen_f(fileName,H5F_ACC_RDWR_F,HDF5_openFile,hdferr,access_prp=plist_access_id)
     call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
   elseif (m == 'r') then
     inquire(file=fileName,exist=exist)
     if (.not. exist) call IO_error(100,trim(fileName))
-    call H5Fopen_f(fileName,H5F_ACC_RDONLY_F,HDF5_openFile,hdferr,access_prp=p_access)
+    call H5Fopen_f(fileName,H5F_ACC_RDONLY_F,HDF5_openFile,hdferr,access_prp=plist_access_id)
     call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
   else
     error stop 'unknown access mode'
   end if
 
-  call H5Pclose_f(p_access, hdferr)
+  call H5Pclose_f(plist_access_id, hdferr)
   call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
-  call H5Pclose_f(p_create, hdferr)
+  call H5Pclose_f(plist_create_id, hdferr)
   call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
 
 end function HDF5_openFile
@@ -247,6 +247,7 @@ subroutine HDF5_closeFile(fileHandle)
 
   integer     :: hdferr
 
+
   call H5Fclose_f(fileHandle,hdferr)
   call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
 
@@ -262,26 +263,35 @@ integer(HID_T) function HDF5_addGroup(fileHandle,groupName)
   character(len=*), intent(in) :: groupName
 
   integer        :: hdferr
-  integer(HID_T) :: aplist_id
+  integer(HID_T) :: gapl_id, gcpl_id
 
-!-------------------------------------------------------------------------------------------------
-! creating a property list for data access properties
-  call H5Pcreate_f(H5P_GROUP_ACCESS_F, aplist_id, hdferr)
-  call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
 
 !-------------------------------------------------------------------------------------------------
-! setting I/O mode to collective
+! set I/O mode to collective (for MPI parallel simulations)
+  call H5Pcreate_f(H5P_GROUP_ACCESS_F,gapl_id,hdferr)
+  call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
 #ifdef PETSC
-  call H5Pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr)
+  call H5Pset_all_coll_metadata_ops_f(gapl_id,.true.,hdferr)
   call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
 #endif
 
+!-------------------------------------------------------------------------------------------------
+! keep creation order in group
+  call H5Pcreate_f(H5P_GROUP_CREATE_F,gcpl_id,hdferr)
+  call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
+  call H5Pset_link_creation_order_f(gcpl_id,ior(H5P_CRT_ORDER_INDEXED_F,H5P_CRT_ORDER_TRACKED_F),hdferr)
+  call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
+
 !-------------------------------------------------------------------------------------------------
 ! Create group
-  call H5Gcreate_f(fileHandle, trim(groupName), HDF5_addGroup, hdferr, OBJECT_NAMELEN_DEFAULT_F,gapl_id = aplist_id)
+  call H5Gcreate_f(fileHandle,trim(groupName),HDF5_addGroup,hdferr, &
+                   OBJECT_NAMELEN_DEFAULT_F,gcpl_id=gcpl_id,gapl_id=gapl_id)
   call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
 
-  call H5Pclose_f(aplist_id,hdferr)
+  call H5Pclose_f(gcpl_id,hdferr)
+  call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
+  call H5Pclose_f(gapl_id,hdferr)
+  call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
 
 end function HDF5_addGroup
 
@@ -331,6 +341,7 @@ subroutine HDF5_closeGroup(group_id)
 
   integer :: hdferr
 
+
   call H5Gclose_f(group_id, hdferr)
   call HDF5_chkerr(hdferr,__FILE__//':'//IO_intAsStr(__LINE__))
 

src/test/test_HDF5_utilities.f90

@@ -19,7 +19,7 @@ end subroutine test_HDF5_utilities_run
 
 subroutine read_write()
 
-  integer(HID_T) :: f, create_list
+  integer(HID_T) :: f,g, plist_create_id
   integer :: hdferr, order
 
   real(pREAL), dimension(3) :: real_d1_in,real_d1_out
@@ -89,20 +89,35 @@ subroutine read_write()
   if (any(int_d4_in /= int_d4_out)) error stop 'test_read_write(w)/int_d4'
   if (any(int_d5_in /= int_d5_out)) error stop 'test_read_write(w)/int_d5'
 
+  call HDF5_closeGroup(HDF5_addGroup(f,'grp'))
 
   call HDF5_closeFile(f)
 
+
   f = HDF5_openFile('test.hdf5','r')
-  call H5Fget_create_plist_f(f,create_list,hdferr)
+
+  call H5Fget_create_plist_f(f,plist_create_id,hdferr)
   call HDF5_chkerr(hdferr)
-  call H5Pget_link_creation_order_f(create_list,order,hdferr)
+  call H5Pget_link_creation_order_f(plist_create_id,order,hdferr)
   call HDF5_chkerr(hdferr)
   ! https://github.com/HDFGroup/hdf5/issues/5183
-  !if (iand(order,H5P_CRT_ORDER_INDEXED_F) /= H5P_CRT_ORDER_INDEXED_F) error stop 'CRT_ORDER_INDEXED'
-  !if (iand(order,H5P_CRT_ORDER_TRACKED_F) /= H5P_CRT_ORDER_TRACKED_F) error stop 'CRT_ORDER_TRACKED'
-  call H5Pclose_f(create_list,hdferr)
+  !if (iand(order,H5P_CRT_ORDER_INDEXED_F) /= H5P_CRT_ORDER_INDEXED_F) error stop 'CRT_ORDER_INDEXED/file'
+  !if (iand(order,H5P_CRT_ORDER_TRACKED_F) /= H5P_CRT_ORDER_TRACKED_F) error stop 'CRT_ORDER_TRACKED/file'
+  call H5Pclose_f(plist_create_id,hdferr)
   call HDF5_chkerr(hdferr)
 
+  g = HDF5_openGroup(f,'grp')
+  call H5Gget_create_plist_f(g,plist_create_id,hdferr)
+  call HDF5_chkerr(hdferr,'H5Gget_create_plist_f')
+  call H5Pget_link_creation_order_f(plist_create_id,order,hdferr)
+  call HDF5_chkerr(hdferr,'H5Pget_link_creation_order_f')
+  if (iand(order,H5P_CRT_ORDER_INDEXED_F) /= H5P_CRT_ORDER_INDEXED_F) error stop 'CRT_ORDER_INDEXED/group'
+  if (iand(order,H5P_CRT_ORDER_TRACKED_F) /= H5P_CRT_ORDER_TRACKED_F) error stop 'CRT_ORDER_TRACKED/group'
+  call H5Pclose_f(plist_create_id,hdferr)
+  call HDF5_chkerr(hdferr,'H5Pclose_f')
+  call HDF5_closeGroup(g)
+
+
   call HDF5_read(real_d1_out,f,'real_d1')
   call HDF5_read(real_d2_out,f,'real_d2')
   call HDF5_read(real_d3_out,f,'real_d3')