From 018709bfcf2b4584a97aeba099424f59308423b0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 11 Nov 2020 10:19:47 +0100 Subject: [PATCH] error stop better suited for internal errors error stop gives full stack trace, which is very helpful for debugging. --- src/HDF5_utilities.f90 | 233 ++++++++++++++++++++--------------------- src/results.f90 | 197 ++++++++++++++++++++-------------- 2 files changed, 235 insertions(+), 195 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 4084b2325..47f4243e7 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -12,11 +12,10 @@ module HDF5_utilities use prec use parallelization - use IO use rotations - implicit none - public + implicit none + public !-------------------------------------------------------------------------------------------------- !> @brief reads integer or float data of defined shape from file ! ToDo: order of arguments wrong @@ -93,15 +92,15 @@ subroutine HDF5_utilities_init !-------------------------------------------------------------------------------------------------- !initialize HDF5 library and check if integer and float type size match call h5open_f(hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_Utilities_init: h5open_f') + if(hdferr < 0) error stop 'HDF5 error' call h5tget_size_f(H5T_NATIVE_INTEGER,typeSize, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_Utilities_init: h5tget_size_f (int)') + if(hdferr < 0) error stop 'HDF5 error' if (int(bit_size(0),SIZE_T)/=typeSize*8) & error stop 'Default integer size does not match H5T_NATIVE_INTEGER' call h5tget_size_f(H5T_NATIVE_DOUBLE,typeSize, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_Utilities_init: h5tget_size_f (double)') + if(hdferr < 0) error stop 'HDF5 error' if (int(storage_size(0.0_pReal),SIZE_T)/=typeSize*8) & error stop 'pReal does not match H5T_NATIVE_DOUBLE' @@ -128,30 +127,30 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel) endif call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_openFile: h5pcreate_f') + if(hdferr < 0) error stop 'HDF5 error' #ifdef PETSc if (present(parallel)) then; if (parallel) then call h5pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_openFile: h5pset_fapl_mpio_f') + if(hdferr < 0) error stop 'HDF5 error' endif; endif #endif if (m == 'w') then call h5fcreate_f(fileName,H5F_ACC_TRUNC_F,HDF5_openFile,hdferr,access_prp = plist_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_openFile: h5fcreate_f (w)') + if(hdferr < 0) error stop 'HDF5 error' elseif(m == 'a') then call h5fopen_f(fileName,H5F_ACC_RDWR_F,HDF5_openFile,hdferr,access_prp = plist_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_openFile: h5fopen_f (a)') + if(hdferr < 0) error stop 'HDF5 error' elseif(m == 'r') then call h5fopen_f(fileName,H5F_ACC_RDONLY_F,HDF5_openFile,hdferr,access_prp = plist_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_openFile: h5fopen_f (r)') + if(hdferr < 0) error stop 'HDF5 error' else - call IO_error(1,ext_msg='HDF5_openFile: h5fopen_f unknown access mode: '//trim(m)) + error stop 'unknown access mode' endif call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_openFile: h5pclose_f') + if(hdferr < 0) error stop 'HDF5 error' end function HDF5_openFile @@ -166,7 +165,7 @@ subroutine HDF5_closeFile(fileHandle) integer :: hdferr call h5fclose_f(fileHandle,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_closeFile: h5fclose_f') + if(hdferr < 0) error stop 'HDF5 error' end subroutine HDF5_closeFile @@ -185,19 +184,19 @@ integer(HID_T) function HDF5_addGroup(fileHandle,groupName) !------------------------------------------------------------------------------------------------- ! creating a property list for data access properties call h5pcreate_f(H5P_GROUP_ACCESS_F, aplist_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_addGroup: h5pcreate_f ('//trim(groupName)//')') + if(hdferr < 0) error stop 'HDF5 error' !------------------------------------------------------------------------------------------------- ! setting I/O mode to collective #ifdef PETSc call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_addGroup: h5pset_all_coll_metadata_ops_f ('//trim(groupName)//')') + if(hdferr < 0) error stop 'HDF5 error' #endif !------------------------------------------------------------------------------------------------- ! Create group call h5gcreate_f(fileHandle, trim(groupName), HDF5_addGroup, hdferr, OBJECT_NAMELEN_DEFAULT_F,gapl_id = aplist_id) - if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_addGroup: h5gcreate_f ('//trim(groupName)//')') + if(hdferr < 0) error stop 'HDF5 error' call h5pclose_f(aplist_id,hdferr) @@ -221,19 +220,19 @@ integer(HID_T) function HDF5_openGroup(fileHandle,groupName) !------------------------------------------------------------------------------------------------- ! creating a property list for data access properties call h5pcreate_f(H5P_GROUP_ACCESS_F, aplist_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_openGroup: h5pcreate_f ('//trim(groupName)//')') + if(hdferr < 0) error stop 'HDF5 error' !------------------------------------------------------------------------------------------------- ! setting I/O mode to collective #ifdef PETSc call h5pget_all_coll_metadata_ops_f(aplist_id, is_collective, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_openGroup: h5pset_all_coll_metadata_ops_f ('//trim(groupName)//')') + if(hdferr < 0) error stop 'HDF5 error' #endif !------------------------------------------------------------------------------------------------- ! opening the group call h5gopen_f(fileHandle, trim(groupName), HDF5_openGroup, hdferr, gapl_id = aplist_id) - if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_openGroup: h5gopen_f ('//trim(groupName)//')') + if(hdferr < 0) error stop 'HDF5 error' call h5pclose_f(aplist_id,hdferr) @@ -250,7 +249,7 @@ subroutine HDF5_closeGroup(group_id) integer :: hdferr call h5gclose_f(group_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_closeGroup: h5gclose_f (el is ID)', el = int(group_id)) + if(hdferr < 0) error stop 'HDF5 error' end subroutine HDF5_closeGroup @@ -273,11 +272,11 @@ logical function HDF5_objectExists(loc_id,path) endif call h5lexists_f(loc_id, p, HDF5_objectExists, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_objectExists: h5oexists_by_name_f') + if(hdferr < 0) error stop 'HDF5 error' if(HDF5_objectExists) then call h5oexists_by_name_f(loc_id, p, HDF5_objectExists, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_objectExists: h5oexists_by_name_f') + if(hdferr < 0) error stop 'HDF5 error' endif end function HDF5_objectExists @@ -309,25 +308,25 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path) ptr(1) = c_loc(attrValue_) call h5screate_f(H5S_SCALAR_F,space_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5screate_f') + if(hdferr < 0) error stop 'HDF5 error' call h5tcopy_f(H5T_STRING, type_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5tcopy_f') + if(hdferr < 0) error stop 'HDF5 error' call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5aexists_by_name_f') + if(hdferr < 0) error stop 'HDF5 error' if (attrExists) then call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5adelete_by_name_f') + if(hdferr < 0) error stop 'HDF5 error' endif call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),type_id,space_id,attr_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5acreate_f') + if(hdferr < 0) error stop 'HDF5 error' call h5awrite_f(attr_id, type_id, c_loc(ptr(1)), hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5awrite_f') + if(hdferr < 0) error stop 'HDF5 error' call h5aclose_f(attr_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5aclose_f') + if(hdferr < 0) error stop 'HDF5 error' call h5tclose_f(type_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5tclose_f') + if(hdferr < 0) error stop 'HDF5 error' call h5sclose_f(space_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_str: h5sclose_f') + if(hdferr < 0) error stop 'HDF5 error' end subroutine HDF5_addAttribute_str @@ -354,21 +353,21 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path) endif call h5screate_f(H5S_SCALAR_F,space_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5screate_f') + if(hdferr < 0) error stop 'HDF5 error' call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5aexists_by_name_f') + if(hdferr < 0) error stop 'HDF5 error' if (attrExists) then call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5adelete_by_name_f') + if(hdferr < 0) error stop 'HDF5 error' endif call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5acreate_f') + if(hdferr < 0) error stop 'HDF5 error' call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, int([1],HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5awrite_f') + if(hdferr < 0) error stop 'HDF5 error' call h5aclose_f(attr_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5tclose_f') + if(hdferr < 0) error stop 'HDF5 error' call h5sclose_f(space_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int: h5sclose_f') + if(hdferr < 0) error stop 'HDF5 error' end subroutine HDF5_addAttribute_int @@ -395,21 +394,21 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path) endif call h5screate_f(H5S_SCALAR_F,space_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5screate_f') + if(hdferr < 0) error stop 'HDF5 error' call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5aexists_by_name_f') + if(hdferr < 0) error stop 'HDF5 error' if (attrExists) then call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5adelete_by_name_f') + if(hdferr < 0) error stop 'HDF5 error' endif call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5acreate_f') + if(hdferr < 0) error stop 'HDF5 error' call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, int([1],HSIZE_T), hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5awrite_f') + if(hdferr < 0) error stop 'HDF5 error' call h5aclose_f(attr_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5tclose_f') + if(hdferr < 0) error stop 'HDF5 error' call h5sclose_f(space_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_real: h5sclose_f') + if(hdferr < 0) error stop 'HDF5 error' end subroutine HDF5_addAttribute_real @@ -439,21 +438,21 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path) array_size = size(attrValue,kind=HSIZE_T) call h5screate_simple_f(1, array_size, space_id, hdferr, array_size) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5screate_simple_f') + if(hdferr < 0) error stop 'HDF5 error' call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5aexists_by_name_f') + if(hdferr < 0) error stop 'HDF5 error' if (attrExists) then call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5adelete_by_name_f') + if(hdferr < 0) error stop 'HDF5 error' endif call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5acreate_f') + if(hdferr < 0) error stop 'HDF5 error' call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, array_size, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5awrite_f') + if(hdferr < 0) error stop 'HDF5 error' call h5aclose_f(attr_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5tclose_f') + if(hdferr < 0) error stop 'HDF5 error' call h5sclose_f(space_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5sclose_f') + if(hdferr < 0) error stop 'HDF5 error' end subroutine HDF5_addAttribute_int_array @@ -483,21 +482,21 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path) array_size = size(attrValue,kind=HSIZE_T) call h5screate_simple_f(1, array_size, space_id, hdferr, array_size) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5screate_simple_f') + if(hdferr < 0) error stop 'HDF5 error' call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5aexists_by_name_f') + if(hdferr < 0) error stop 'HDF5 error' if (attrExists) then call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5adelete_by_name_f') + if(hdferr < 0) error stop 'HDF5 error' endif call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5acreate_f') + if(hdferr < 0) error stop 'HDF5 error' call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, array_size, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5awrite_f') + if(hdferr < 0) error stop 'HDF5 error' call h5aclose_f(attr_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5tclose_f') + if(hdferr < 0) error stop 'HDF5 error' call h5sclose_f(space_id,hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_addAttribute_int_array: h5sclose_f') + if(hdferr < 0) error stop 'HDF5 error' end subroutine HDF5_addAttribute_real_array @@ -513,13 +512,13 @@ subroutine HDF5_setLink(loc_id,target_name,link_name) logical :: linkExists call h5lexists_f(loc_id, link_name,linkExists, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_setLink: h5lexists_soft_f ('//trim(link_name)//')') + if(hdferr < 0) error stop 'HDF5 error' if (linkExists) then call h5ldelete_f(loc_id,link_name, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_setLink: h5ldelete_soft_f ('//trim(link_name)//')') + if(hdferr < 0) error stop 'HDF5 error' endif call h5lcreate_soft_f(target_name, loc_id, link_name, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg = 'HDF5_setLink: h5lcreate_soft_f ('//trim(target_name)//' '//trim(link_name)//')') + if(hdferr < 0) error stop 'HDF5 error' end subroutine HDF5_setLink @@ -558,7 +557,7 @@ subroutine HDF5_read_real1(loc_id,dataset,datasetName,parallel) call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real1: h5dread_f') + if(hdferr < 0) error stop 'HDF5 error' call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) @@ -598,7 +597,7 @@ subroutine HDF5_read_real2(loc_id,dataset,datasetName,parallel) call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real2: h5dread_f') + if(hdferr < 0) error stop 'HDF5 error' call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) @@ -638,7 +637,7 @@ subroutine HDF5_read_real3(loc_id,dataset,datasetName,parallel) call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real3: h5dread_f') + if(hdferr < 0) error stop 'HDF5 error' call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) @@ -678,7 +677,7 @@ subroutine HDF5_read_real4(loc_id,dataset,datasetName,parallel) call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real4: h5dread_f') + if(hdferr < 0) error stop 'HDF5 error' call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) @@ -718,7 +717,7 @@ subroutine HDF5_read_real5(loc_id,dataset,datasetName,parallel) call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real5: h5dread_f') + if(hdferr < 0) error stop 'HDF5 error' call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) @@ -758,7 +757,7 @@ subroutine HDF5_read_real6(loc_id,dataset,datasetName,parallel) call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real6: h5dread_f') + if(hdferr < 0) error stop 'HDF5 error' call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) @@ -798,7 +797,7 @@ subroutine HDF5_read_real7(loc_id,dataset,datasetName,parallel) call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_real7: h5dread_f') + if(hdferr < 0) error stop 'HDF5 error' call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) @@ -840,7 +839,7 @@ subroutine HDF5_read_int1(loc_id,dataset,datasetName,parallel) call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int1: h5dread_f') + if(hdferr < 0) error stop 'HDF5 error' call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) @@ -880,7 +879,7 @@ subroutine HDF5_read_int2(loc_id,dataset,datasetName,parallel) call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int2: h5dread_f') + if(hdferr < 0) error stop 'HDF5 error' call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) @@ -920,7 +919,7 @@ subroutine HDF5_read_int3(loc_id,dataset,datasetName,parallel) call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int3: h5dread_f') + if(hdferr < 0) error stop 'HDF5 error' call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) @@ -960,7 +959,7 @@ subroutine HDF5_read_int4(loc_id,dataset,datasetName,parallel) call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int4: h5dread_f') + if(hdferr < 0) error stop 'HDF5 error' call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) @@ -1000,7 +999,7 @@ subroutine HDF5_read_int5(loc_id,dataset,datasetName,parallel) call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int5: h5dread_f') + if(hdferr < 0) error stop 'HDF5 error' call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) @@ -1040,7 +1039,7 @@ subroutine HDF5_read_int6(loc_id,dataset,datasetName,parallel) call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int6: h5dread_f') + if(hdferr < 0) error stop 'HDF5 error' call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) @@ -1080,7 +1079,7 @@ subroutine HDF5_read_int7(loc_id,dataset,datasetName,parallel) call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,& file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_read_int7: h5dread_f') + if(hdferr < 0) error stop 'HDF5 error' call finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) @@ -1121,7 +1120,7 @@ subroutine HDF5_write_real1(loc_id,dataset,datasetName,parallel) if (product(totalShape) /= 0) then call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real1: h5dwrite_f') + if(hdferr < 0) error stop 'HDF5 error' endif call finalize_write(plist_id, dset_id, filespace_id, memspace_id) @@ -1162,7 +1161,7 @@ subroutine HDF5_write_real2(loc_id,dataset,datasetName,parallel) if (product(totalShape) /= 0) then call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real2: h5dwrite_f') + if(hdferr < 0) error stop 'HDF5 error' endif call finalize_write(plist_id, dset_id, filespace_id, memspace_id) @@ -1203,7 +1202,7 @@ subroutine HDF5_write_real3(loc_id,dataset,datasetName,parallel) if (product(totalShape) /= 0) then call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real3: h5dwrite_f') + if(hdferr < 0) error stop 'HDF5 error' endif call finalize_write(plist_id, dset_id, filespace_id, memspace_id) @@ -1244,7 +1243,7 @@ subroutine HDF5_write_real4(loc_id,dataset,datasetName,parallel) if (product(totalShape) /= 0) then call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real4: h5dwrite_f') + if(hdferr < 0) error stop 'HDF5 error' endif call finalize_write(plist_id, dset_id, filespace_id, memspace_id) @@ -1286,7 +1285,7 @@ subroutine HDF5_write_real5(loc_id,dataset,datasetName,parallel) if (product(totalShape) /= 0) then call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real5: h5dwrite_f') + if(hdferr < 0) error stop 'HDF5 error' endif call finalize_write(plist_id, dset_id, filespace_id, memspace_id) @@ -1327,7 +1326,7 @@ subroutine HDF5_write_real6(loc_id,dataset,datasetName,parallel) if (product(totalShape) /= 0) then call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real6: h5dwrite_f') + if(hdferr < 0) error stop 'HDF5 error' endif call finalize_write(plist_id, dset_id, filespace_id, memspace_id) @@ -1368,7 +1367,7 @@ subroutine HDF5_write_real7(loc_id,dataset,datasetName,parallel) if (product(totalShape) /= 0) then call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_real7: h5dwrite_f') + if(hdferr < 0) error stop 'HDF5 error' endif call finalize_write(plist_id, dset_id, filespace_id, memspace_id) @@ -1410,7 +1409,7 @@ subroutine HDF5_write_int1(loc_id,dataset,datasetName,parallel) if (product(totalShape) /= 0) then call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int1: h5dwrite_f') + if(hdferr < 0) error stop 'HDF5 error' endif call finalize_write(plist_id, dset_id, filespace_id, memspace_id) @@ -1451,7 +1450,7 @@ subroutine HDF5_write_int2(loc_id,dataset,datasetName,parallel) if (product(totalShape) /= 0) then call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int2: h5dwrite_f') + if(hdferr < 0) error stop 'HDF5 error' endif call finalize_write(plist_id, dset_id, filespace_id, memspace_id) @@ -1492,7 +1491,7 @@ subroutine HDF5_write_int3(loc_id,dataset,datasetName,parallel) if (product(totalShape) /= 0) then call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int3: h5dwrite_f') + if(hdferr < 0) error stop 'HDF5 error' endif call finalize_write(plist_id, dset_id, filespace_id, memspace_id) @@ -1533,7 +1532,7 @@ subroutine HDF5_write_int4(loc_id,dataset,datasetName,parallel) if (product(totalShape) /= 0) then call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int4: h5dwrite_f') + if(hdferr < 0) error stop 'HDF5 error' endif call finalize_write(plist_id, dset_id, filespace_id, memspace_id) @@ -1574,7 +1573,7 @@ subroutine HDF5_write_int5(loc_id,dataset,datasetName,parallel) if (product(totalShape) /= 0) then call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int5: h5dwrite_f') + if(hdferr < 0) error stop 'HDF5 error' endif call finalize_write(plist_id, dset_id, filespace_id, memspace_id) @@ -1615,7 +1614,7 @@ subroutine HDF5_write_int6(loc_id,dataset,datasetName,parallel) if (product(totalShape) /= 0) then call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int6: h5dwrite_f') + if(hdferr < 0) error stop 'HDF5 error' endif call finalize_write(plist_id, dset_id, filespace_id, memspace_id) @@ -1656,7 +1655,7 @@ subroutine HDF5_write_int7(loc_id,dataset,datasetName,parallel) if (product(totalShape) /= 0) then call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_int7: h5dwrite_f') + if(hdferr < 0) error stop 'HDF5 error' endif call finalize_write(plist_id, dset_id, filespace_id, memspace_id) @@ -1732,7 +1731,7 @@ subroutine HDF5_write_rotation(loc_id,dataset,datasetName,parallel) file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) call h5dwrite_f(dset_id, z_id,dataset_asArray(4,:),int(totalShape,HSIZE_T), hdferr,& file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (hdferr < 0) call IO_error(1,ext_msg='HDF5_write_rotation: h5dwrite_f') + if(hdferr < 0) error stop 'HDF5 error' endif call finalize_write(plist_id, dset_id, filespace_id, memspace_id) @@ -1765,7 +1764,7 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_ !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties (is collective for MPI) call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pcreate_f') + if(hdferr < 0) error stop 'HDF5 error' !-------------------------------------------------------------------------------------------------- readSize = 0 @@ -1773,9 +1772,9 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_ #ifdef PETSc if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pset_dxpl_mpio_f') + if(hdferr < 0) error stop 'HDF5 error' call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894,ext_msg='initialize_read: MPI_allreduce') + if (ierr /= 0) error stop 'MPI error' endif #endif myStart = int(0,HSIZE_T) @@ -1785,28 +1784,28 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_ !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) call h5screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5screate_simple_f/memspace_id') + if(hdferr < 0) error stop 'HDF5 error' !-------------------------------------------------------------------------------------------------- ! creating a property list for IO and set it to collective call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pcreate_f') + if(hdferr < 0) error stop 'HDF5 error' #ifdef PETSc call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5pset_all_coll_metadata_ops_f') + if(hdferr < 0) error stop 'HDF5 error' #endif !-------------------------------------------------------------------------------------------------- ! open the dataset in the file and get the space ID call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5dopen_f') + if(hdferr < 0) error stop 'HDF5 error' call h5dget_space_f(dset_id, filespace_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5dget_space_f') + if(hdferr < 0) error stop 'HDF5 error' !-------------------------------------------------------------------------------------------------- ! select a hyperslab (the portion of the current process) in the file call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_read: h5sselect_hyperslab_f') + if(hdferr < 0) error stop 'HDF5 error' end subroutine initialize_read @@ -1820,15 +1819,15 @@ subroutine finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id integer :: hdferr call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: plist_id') + if(hdferr < 0) error stop 'HDF5 error' call h5pclose_f(aplist_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: aplist_id') + if(hdferr < 0) error stop 'HDF5 error' call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: h5dclose_f') + if(hdferr < 0) error stop 'HDF5 error' call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: h5sclose_f/filespace_id') + if(hdferr < 0) error stop 'HDF5 error' call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='finalize_read: h5sclose_f/memspace_id') + if(hdferr < 0) error stop 'HDF5 error' end subroutine finalize_read @@ -1859,11 +1858,11 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & !------------------------------------------------------------------------------------------------- ! creating a property list for transfer properties (is collective when reading in parallel) call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5pcreate_f') + if(hdferr < 0) error stop 'HDF5 error' #ifdef PETSc if (parallel) then call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5pset_dxpl_mpio_f') + if(hdferr < 0) error stop 'HDF5 error' endif #endif @@ -1874,7 +1873,7 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & #ifdef PETSc if (parallel) then call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process - if (ierr /= 0) call IO_error(894,ext_msg='initialize_write: MPI_allreduce') + if (ierr /= 0) error stop 'MPI error' endif #endif myStart = int(0,HSIZE_T) @@ -1884,16 +1883,16 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape) and in file (global shape) call h5screate_simple_f(size(myShape), myShape, memspace_id, hdferr, myShape) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5dopen_f') + if(hdferr < 0) error stop 'HDF5 error' call h5screate_simple_f(size(totalShape), totalShape, filespace_id, hdferr, totalShape) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5dget_space_f') + if(hdferr < 0) error stop 'HDF5 error' !-------------------------------------------------------------------------------------------------- ! create dataset in the file and select a hyperslab from it (the portion of the current process) call h5dcreate_f(loc_id, trim(datasetName), datatype, filespace_id, dset_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5dcreate_f') + if(hdferr < 0) error stop 'HDF5 error' call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, myShape, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='initialize_write: h5sselect_hyperslab_f') + if(hdferr < 0) error stop 'HDF5 error' end subroutine initialize_write @@ -1907,13 +1906,13 @@ subroutine finalize_write(plist_id, dset_id, filespace_id, memspace_id) integer :: hdferr call h5pclose_f(plist_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: plist_id') + if(hdferr < 0) error stop 'HDF5 error' call h5dclose_f(dset_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: h5dclose_f') + if(hdferr < 0) error stop 'HDF5 error' call h5sclose_f(filespace_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: h5sclose_f/filespace_id') + if(hdferr < 0) error stop 'HDF5 error' call h5sclose_f(memspace_id, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg='finalize_write: h5sclose_f/memspace_id') + if(hdferr < 0) error stop 'HDF5 error' end subroutine finalize_write diff --git a/src/results.f90 b/src/results.f90 index 4811b52b5..eac894c11 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -7,6 +7,7 @@ module results use DAMASK_interface use parallelization + use IO use rotations use HDF5_utilities #ifdef PETSc @@ -535,33 +536,46 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label) integer(SIZE_T) :: type_size_string, type_size_int - integer :: ierr, i + integer :: hdferr, ierr, i !--------------------------------------------------------------------------------------------------- ! compound type: name of phase section + position/index within results array - call h5tcopy_f(H5T_NATIVE_CHARACTER, dt_id, ierr) - call h5tset_size_f(dt_id, int(len(label(1)),SIZE_T), ierr) - call h5tget_size_f(dt_id, type_size_string, ierr) + call h5tcopy_f(H5T_NATIVE_CHARACTER, dt_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5tset_size_f(dt_id, int(len(label(1)),SIZE_T), hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5tget_size_f(dt_id, type_size_string, hdferr) + if(hdferr < 0) error stop 'HDF5 error' - call h5tget_size_f(H5T_NATIVE_INTEGER, type_size_int, ierr) + call h5tget_size_f(H5T_NATIVE_INTEGER, type_size_int, hdferr) + if(hdferr < 0) error stop 'HDF5 error' - call h5tcreate_f(H5T_COMPOUND_F, type_size_string + type_size_int, dtype_id, ierr) - call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt_id,ierr) - call h5tinsert_f(dtype_id, "Position", type_size_string, H5T_NATIVE_INTEGER, ierr) + call h5tcreate_f(H5T_COMPOUND_F, type_size_string + type_size_int, dtype_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt_id,hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5tinsert_f(dtype_id, "Position", type_size_string, H5T_NATIVE_INTEGER, hdferr) + if(hdferr < 0) error stop 'HDF5 error' !-------------------------------------------------------------------------------------------------- ! create memory types for each component of the compound type - call h5tcreate_f(H5T_COMPOUND_F, type_size_string, name_id, ierr) - call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt_id, ierr) + call h5tcreate_f(H5T_COMPOUND_F, type_size_string, name_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' - call h5tcreate_f(H5T_COMPOUND_F, type_size_int, position_id, ierr) - call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_NATIVE_INTEGER, ierr) + call h5tcreate_f(H5T_COMPOUND_F, type_size_int, position_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_NATIVE_INTEGER, hdferr) + if(hdferr < 0) error stop 'HDF5 error' - call h5tclose_f(dt_id, ierr) + call h5tclose_f(dt_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' !-------------------------------------------------------------------------------------------------- ! prepare MPI communication (transparent for non-MPI runs) - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, ierr) + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' memberOffset = 0 do i=1, size(label) memberOffset(i,worldrank) = count(phaseAt == i)*size(memberAtLocal,2) ! number of points/instance of this process @@ -572,14 +586,14 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label) !-------------------------------------------------------------------------------------------------- ! MPI settings and communication #ifdef PETSc - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, ierr) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_constituent: h5pset_dxpl_mpio_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if(hdferr < 0) error stop 'HDF5 error' call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get output at each process - if (ierr /= 0) call IO_error(894,ext_msg='results_mapping_constituent: MPI_allreduce/writeSize') + if(ierr /= 0) error stop 'MPI error' call MPI_allreduce(MPI_IN_PLACE,memberOffset,size(memberOffset),MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)! get offset at each process - if (ierr /= 0) call IO_error(894,ext_msg='results_mapping_constituent: MPI_allreduce/memberOffset') + if(ierr /= 0) error stop 'MPI error' #endif myShape = int([size(phaseAt,1),writeSize(worldrank)], HSIZE_T) @@ -588,14 +602,14 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label) !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape = hyperslab) and in file (global shape) - call h5screate_simple_f(2,myShape,memspace_id,ierr,myShape) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_constituent: h5screate_simple_f/memspace_id') + call h5screate_simple_f(2,myShape,memspace_id,hdferr,myShape) + if(hdferr < 0) error stop 'HDF5 error' - call h5screate_simple_f(2,totalShape,filespace_id,ierr,totalShape) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_constituent: h5screate_simple_f/filespace_id') + call h5screate_simple_f(2,totalShape,filespace_id,hdferr,totalShape) + if(hdferr < 0) error stop 'HDF5 error' - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, ierr) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_constituent: h5sselect_hyperslab_f') + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, hdferr) + if(hdferr < 0) error stop 'HDF5 error' !--------------------------------------------------------------------------------------------------- ! expand phaseAt to consider IPs (is not stored per IP) @@ -611,29 +625,36 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label) !-------------------------------------------------------------------------------------------------- ! write the components of the compound type individually - call h5pset_preserve_f(plist_id, .TRUE., ierr) + call h5pset_preserve_f(plist_id, .TRUE., hdferr) + if(hdferr < 0) error stop 'HDF5 error' loc_id = results_openGroup('/mapping') - call h5dcreate_f(loc_id, 'phase', dtype_id, filespace_id, dset_id, ierr) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_constituent: h5dcreate_f') + call h5dcreate_f(loc_id, 'phase', dtype_id, filespace_id, dset_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' call h5dwrite_f(dset_id, name_id, reshape(label(pack(phaseAtMaterialpoint,.true.)),myShape), & - myShape, ierr, file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_constituent: h5dwrite_f/name_id') + myShape, hdferr, file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) + if(hdferr < 0) error stop 'HDF5 error' call h5dwrite_f(dset_id, position_id, reshape(pack(memberAtGlobal,.true.),myShape), & - myShape, ierr, file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_constituent: h5dwrite_f/position_id') + myShape, hdferr, file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) + if(hdferr < 0) error stop 'HDF5 error' !-------------------------------------------------------------------------------------------------- ! close all call HDF5_closeGroup(loc_id) - call h5pclose_f(plist_id, ierr) - call h5sclose_f(filespace_id, ierr) - call h5sclose_f(memspace_id, ierr) - call h5dclose_f(dset_id, ierr) - call h5tclose_f(dtype_id, ierr) - call h5tclose_f(name_id, ierr) - call h5tclose_f(position_id, ierr) + call h5pclose_f(plist_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5sclose_f(filespace_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5sclose_f(memspace_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5dclose_f(dset_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5tclose_f(dtype_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5tclose_f(name_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5tclose_f(position_id, hdferr) ! for backward compatibility call results_setLink('/mapping/phase','/mapping/cellResults/constituent') @@ -673,51 +694,64 @@ subroutine results_mapping_homogenization(homogenizationAt,memberAtLocal,label) integer(SIZE_T) :: type_size_string, type_size_int - integer :: ierr, i + integer :: hdferr, ierr, i !--------------------------------------------------------------------------------------------------- ! compound type: name of phase section + position/index within results array - call h5tcopy_f(H5T_NATIVE_CHARACTER, dt_id, ierr) - call h5tset_size_f(dt_id, int(len(label(1)),SIZE_T), ierr) - call h5tget_size_f(dt_id, type_size_string, ierr) + call h5tcopy_f(H5T_NATIVE_CHARACTER, dt_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5tset_size_f(dt_id, int(len(label(1)),SIZE_T), hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5tget_size_f(dt_id, type_size_string, hdferr) + if(hdferr < 0) error stop 'HDF5 error' - call h5tget_size_f(H5T_NATIVE_INTEGER, type_size_int, ierr) + call h5tget_size_f(H5T_NATIVE_INTEGER, type_size_int, hdferr) + if(hdferr < 0) error stop 'HDF5 error' - call h5tcreate_f(H5T_COMPOUND_F, type_size_string + type_size_int, dtype_id, ierr) - call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt_id,ierr) - call h5tinsert_f(dtype_id, "Position", type_size_string, H5T_NATIVE_INTEGER, ierr) + call h5tcreate_f(H5T_COMPOUND_F, type_size_string + type_size_int, dtype_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt_id,hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5tinsert_f(dtype_id, "Position", type_size_string, H5T_NATIVE_INTEGER, hdferr) + if(hdferr < 0) error stop 'HDF5 error' !-------------------------------------------------------------------------------------------------- ! create memory types for each component of the compound type - call h5tcreate_f(H5T_COMPOUND_F, type_size_string, name_id, ierr) - call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt_id, ierr) + call h5tcreate_f(H5T_COMPOUND_F, type_size_string, name_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' - call h5tcreate_f(H5T_COMPOUND_F, type_size_int, position_id, ierr) - call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_NATIVE_INTEGER, ierr) + call h5tcreate_f(H5T_COMPOUND_F, type_size_int, position_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_NATIVE_INTEGER, hdferr) + if(hdferr < 0) error stop 'HDF5 error' - call h5tclose_f(dt_id, ierr) + call h5tclose_f(dt_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' !-------------------------------------------------------------------------------------------------- ! prepare MPI communication (transparent for non-MPI runs) - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, ierr) + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' memberOffset = 0 do i=1, size(label) - memberOffset(i,worldrank) = count(homogenizationAt == i)*size(memberAtLocal,1) ! number of points/instance of this process + memberOffset(i,worldrank) = count(homogenizationAt == i)*size(memberAtLocal,1) ! number of points/instance of this process enddo writeSize = 0 - writeSize(worldrank) = size(memberAtLocal) ! total number of points by this process + writeSize(worldrank) = size(memberAtLocal) ! total number of points by this process !-------------------------------------------------------------------------------------------------- ! MPI settings and communication #ifdef PETSc - call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, ierr) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_homogenization: h5pset_dxpl_mpio_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if(hdferr < 0) error stop 'HDF5 error' call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get output at each process - if (ierr /= 0) call IO_error(894,ext_msg='results_mapping_homogenization: MPI_allreduce/writeSize') + if(ierr /= 0) error stop 'MPI error' call MPI_allreduce(MPI_IN_PLACE,memberOffset,size(memberOffset),MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)! get offset at each process - if (ierr /= 0) call IO_error(894,ext_msg='results_mapping_homogenization: MPI_allreduce/memberOffset') + if(ierr /= 0) error stop 'MPI error' #endif myShape = int([writeSize(worldrank)], HSIZE_T) @@ -726,14 +760,14 @@ subroutine results_mapping_homogenization(homogenizationAt,memberAtLocal,label) !-------------------------------------------------------------------------------------------------- ! create dataspace in memory (local shape = hyperslab) and in file (global shape) - call h5screate_simple_f(1,myShape,memspace_id,ierr,myShape) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_homogenization: h5screate_simple_f/memspace_id') + call h5screate_simple_f(1,myShape,memspace_id,hdferr,myShape) + if(hdferr < 0) error stop 'HDF5 error' - call h5screate_simple_f(1,totalShape,filespace_id,ierr,totalShape) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_homogenization: h5screate_simple_f/filespace_id') + call h5screate_simple_f(1,totalShape,filespace_id,hdferr,totalShape) + if(hdferr < 0) error stop 'HDF5 error' - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, ierr) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_homogenization: h5sselect_hyperslab_f') + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, hdferr) + if(hdferr < 0) error stop 'HDF5 error' !--------------------------------------------------------------------------------------------------- ! expand phaseAt to consider IPs (is not stored per IP) @@ -749,29 +783,36 @@ subroutine results_mapping_homogenization(homogenizationAt,memberAtLocal,label) !-------------------------------------------------------------------------------------------------- ! write the components of the compound type individually - call h5pset_preserve_f(plist_id, .TRUE., ierr) + call h5pset_preserve_f(plist_id, .TRUE., hdferr) loc_id = results_openGroup('/mapping') - call h5dcreate_f(loc_id, 'homogenization', dtype_id, filespace_id, dset_id, ierr) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_homogenization: h5dcreate_f') + call h5dcreate_f(loc_id, 'homogenization', dtype_id, filespace_id, dset_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' call h5dwrite_f(dset_id, name_id, reshape(label(pack(homogenizationAtMaterialpoint,.true.)),myShape), & - myShape, ierr, file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_homogenization: h5dwrite_f/name_id') + myShape, hdferr, file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) + if(hdferr < 0) error stop 'HDF5 error' call h5dwrite_f(dset_id, position_id, reshape(pack(memberAtGlobal,.true.),myShape), & - myShape, ierr, file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_homogenization: h5dwrite_f/position_id') + myShape, hdferr, file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) + if(hdferr < 0) error stop 'HDF5 error' !-------------------------------------------------------------------------------------------------- ! close all call HDF5_closeGroup(loc_id) - call h5pclose_f(plist_id, ierr) - call h5sclose_f(filespace_id, ierr) - call h5sclose_f(memspace_id, ierr) - call h5dclose_f(dset_id, ierr) - call h5tclose_f(dtype_id, ierr) - call h5tclose_f(name_id, ierr) - call h5tclose_f(position_id, ierr) + call h5pclose_f(plist_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5sclose_f(filespace_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5sclose_f(memspace_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5dclose_f(dset_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5tclose_f(dtype_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5tclose_f(name_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + call h5tclose_f(position_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' ! for backward compatibility call results_setLink('/mapping/homogenization','/mapping/cellResults/materialpoint')