diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 8ce8bd4cc..0b92b9b1e 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -94,7 +94,6 @@ contains !-------------------------------------------------------------------------------------------------- subroutine HDF5_utilities_init - implicit none integer :: hdferr integer(SIZE_T) :: typeSize @@ -123,7 +122,6 @@ end subroutine HDF5_utilities_init !-------------------------------------------------------------------------------------------------- integer(HID_T) function HDF5_openFile(fileName,mode,parallel) ! ToDo: simply "open" is enough - implicit none character(len=*), intent(in) :: fileName character, intent(in), optional :: mode logical, intent(in), optional :: parallel @@ -172,7 +170,6 @@ end function HDF5_openFile !-------------------------------------------------------------------------------------------------- subroutine HDF5_closeFile(fileHandle) - implicit none integer(HID_T), intent(in) :: fileHandle integer :: hdferr @@ -188,7 +185,6 @@ end subroutine HDF5_closeFile !-------------------------------------------------------------------------------------------------- integer(HID_T) function HDF5_addGroup(fileHandle,groupName) - implicit none integer(HID_T), intent(in) :: fileHandle character(len=*), intent(in) :: groupName @@ -212,6 +208,8 @@ integer(HID_T) function HDF5_addGroup(fileHandle,groupName) call h5gcreate_f(fileHandle, trim(groupName), HDF5_addGroup, hdferr, OBJECT_NAMELEN_DEFAULT_F,gapl_id = aplist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_addGroup: h5gcreate_f ('//trim(groupName)//')') + call h5pclose_f(aplist_id) + end function HDF5_addGroup @@ -220,7 +218,6 @@ end function HDF5_addGroup !-------------------------------------------------------------------------------------------------- integer(HID_T) function HDF5_openGroup(fileHandle,groupName) - implicit none integer(HID_T), intent(in) :: fileHandle character(len=*), intent(in) :: groupName @@ -247,6 +244,8 @@ integer(HID_T) function HDF5_openGroup(fileHandle,groupName) call h5gopen_f(fileHandle, trim(groupName), HDF5_openGroup, hdferr, gapl_id = aplist_id) if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_openGroup: h5gopen_f ('//trim(groupName)//')') + call h5pclose_f(aplist_id) + end function HDF5_openGroup @@ -255,7 +254,6 @@ end function HDF5_openGroup !-------------------------------------------------------------------------------------------------- subroutine HDF5_closeGroup(group_id) - implicit none integer(HID_T), intent(in) :: group_id integer :: hdferr @@ -270,7 +268,6 @@ end subroutine HDF5_closeGroup !-------------------------------------------------------------------------------------------------- logical function HDF5_objectExists(loc_id,path) - implicit none integer(HID_T), intent(in) :: loc_id character(len=*), intent(in), optional :: path integer :: hdferr @@ -298,7 +295,6 @@ end function HDF5_objectExists !-------------------------------------------------------------------------------------------------- subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path) - implicit none integer(HID_T), intent(in) :: loc_id character(len=*), intent(in) :: attrLabel, attrValue character(len=*), intent(in), optional :: path @@ -344,7 +340,6 @@ end subroutine HDF5_addAttribute_str !-------------------------------------------------------------------------------------------------- subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path) - implicit none integer(HID_T), intent(in) :: loc_id character(len=*), intent(in) :: attrLabel integer(pInt), intent(in) :: attrValue @@ -391,7 +386,6 @@ end subroutine HDF5_addAttribute_int !-------------------------------------------------------------------------------------------------- subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path) - implicit none integer(HID_T), intent(in) :: loc_id character(len=*), intent(in) :: attrLabel real(pReal), intent(in) :: attrValue @@ -438,7 +432,6 @@ end subroutine HDF5_addAttribute_real !-------------------------------------------------------------------------------------------------- subroutine HDF5_setLink(loc_id,target_name,link_name) - implicit none character(len=*), intent(in) :: target_name, link_name integer(HID_T), intent(in) :: loc_id integer :: hdferr @@ -461,7 +454,6 @@ end subroutine HDF5_setLink !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_real1(loc_id,dataset,datasetName,parallel) - implicit none real(pReal), intent(inout), dimension(:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file @@ -502,7 +494,6 @@ end subroutine HDF5_read_real1 !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_real2(loc_id,dataset,datasetName,parallel) - implicit none real(pReal), intent(inout), dimension(:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file @@ -543,7 +534,6 @@ end subroutine HDF5_read_real2 !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_real3(loc_id,dataset,datasetName,parallel) - implicit none real(pReal), intent(inout), dimension(:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file @@ -584,7 +574,6 @@ end subroutine HDF5_read_real3 !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_real4(loc_id,dataset,datasetName,parallel) - implicit none real(pReal), intent(inout), dimension(:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file @@ -625,7 +614,6 @@ end subroutine HDF5_read_real4 !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_real5(loc_id,dataset,datasetName,parallel) - implicit none real(pReal), intent(inout), dimension(:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file @@ -666,7 +654,6 @@ end subroutine HDF5_read_real5 !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_real6(loc_id,dataset,datasetName,parallel) - implicit none real(pReal), intent(inout), dimension(:,:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file @@ -707,7 +694,6 @@ end subroutine HDF5_read_real6 !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_real7(loc_id,dataset,datasetName,parallel) - implicit none real(pReal), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file @@ -749,7 +735,6 @@ end subroutine HDF5_read_real7 !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_int1(loc_id,dataset,datasetName,parallel) - implicit none integer, intent(inout), dimension(:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file @@ -790,7 +775,6 @@ end subroutine HDF5_read_int1 !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_int2(loc_id,dataset,datasetName,parallel) - implicit none integer, intent(inout), dimension(:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file @@ -831,7 +815,6 @@ end subroutine HDF5_read_int2 !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_int3(loc_id,dataset,datasetName,parallel) - implicit none integer, intent(inout), dimension(:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file @@ -872,7 +855,6 @@ end subroutine HDF5_read_int3 !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_int4(loc_id,dataset,datasetName,parallel) - implicit none integer, intent(inout), dimension(:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file @@ -913,7 +895,6 @@ end subroutine HDF5_read_int4 !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_int5(loc_id,dataset,datasetName,parallel) - implicit none integer, intent(inout), dimension(:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file @@ -954,7 +935,6 @@ end subroutine HDF5_read_int5 !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_int6(loc_id,dataset,datasetName,parallel) - implicit none integer, intent(inout), dimension(:,:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file @@ -995,7 +975,6 @@ end subroutine HDF5_read_int6 !-------------------------------------------------------------------------------------------------- subroutine HDF5_read_int7(loc_id,dataset,datasetName,parallel) - implicit none integer, intent(inout), dimension(:,:,:,:,:,:,:) :: dataset integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file @@ -1037,40 +1016,39 @@ end subroutine HDF5_read_int7 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_real1(loc_id,dataset,datasetName,parallel) - implicit none - real(pReal), intent(inout), dimension(:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel + real(pReal), intent(inout), dimension(:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) + integer :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + myShape, & !< shape of the dataset (this process) + totalShape !< shape of the dataset (all processes) !--------------------------------------------------------------------------------------------------- ! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) + myShape = int(shape(dataset),HSIZE_T) + if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - if (present(parallel)) then - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif - 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_pInt,ext_msg='HDF5_write_real1: h5dwrite_f') - endif + 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_pInt,ext_msg='HDF5_write_real1: h5dwrite_f') + endif - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_real1 @@ -1079,40 +1057,39 @@ end subroutine HDF5_write_real1 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_real2(loc_id,dataset,datasetName,parallel) - implicit none - real(pReal), intent(inout), dimension(:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel + real(pReal), intent(inout), dimension(:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) + integer :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + myShape, & !< shape of the dataset (this process) + totalShape !< shape of the dataset (all processes) !--------------------------------------------------------------------------------------------------- ! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) + myShape = int(shape(dataset),HSIZE_T) + if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - if (present(parallel)) then - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif - 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_pInt,ext_msg='HDF5_write_real2: h5dwrite_f') - endif + 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_pInt,ext_msg='HDF5_write_real2: h5dwrite_f') + endif - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_real2 @@ -1121,40 +1098,39 @@ end subroutine HDF5_write_real2 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_real3(loc_id,dataset,datasetName,parallel) - implicit none - real(pReal), intent(inout), dimension(:,:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel + real(pReal), intent(inout), dimension(:,:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) + integer :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + myShape, & !< shape of the dataset (this process) + totalShape !< shape of the dataset (all processes) !--------------------------------------------------------------------------------------------------- ! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) + myShape = int(shape(dataset),HSIZE_T) + if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - if (present(parallel)) then - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif - 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_pInt,ext_msg='HDF5_write_real3: h5dwrite_f') - endif + 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_pInt,ext_msg='HDF5_write_real3: h5dwrite_f') + endif - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_real3 @@ -1163,40 +1139,39 @@ end subroutine HDF5_write_real3 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_real4(loc_id,dataset,datasetName,parallel) - implicit none - real(pReal), intent(inout), dimension(:,:,:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel + real(pReal), intent(inout), dimension(:,:,:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) + integer :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + myShape, & !< shape of the dataset (this process) + totalShape !< shape of the dataset (all processes) !--------------------------------------------------------------------------------------------------- ! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - - if (present(parallel)) then - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) - endif - - 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_pInt,ext_msg='HDF5_write_real4: h5dwrite_f') - endif + myShape = int(shape(dataset),HSIZE_T) + if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif + + 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_pInt,ext_msg='HDF5_write_real4: h5dwrite_f') + endif + + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_real4 @@ -1206,40 +1181,39 @@ end subroutine HDF5_write_real4 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_real5(loc_id,dataset,datasetName,parallel) - implicit none - real(pReal), intent(inout), dimension(:,:,:,:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel + real(pReal), intent(inout), dimension(:,:,:,:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) + integer :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + myShape, & !< shape of the dataset (this process) + totalShape !< shape of the dataset (all processes) !--------------------------------------------------------------------------------------------------- ! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - - if (present(parallel)) then - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) - endif - - 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_pInt,ext_msg='HDF5_write_real5: h5dwrite_f') - endif + myShape = int(shape(dataset),HSIZE_T) + if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif + + 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_pInt,ext_msg='HDF5_write_real5: h5dwrite_f') + endif + + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_real5 @@ -1248,40 +1222,39 @@ end subroutine HDF5_write_real5 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_real6(loc_id,dataset,datasetName,parallel) - implicit none - real(pReal), intent(inout), dimension(:,:,:,:,:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel + real(pReal), intent(inout), dimension(:,:,:,:,:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) + integer :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + myShape, & !< shape of the dataset (this process) + totalShape !< shape of the dataset (all processes) !--------------------------------------------------------------------------------------------------- ! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) + myShape = int(shape(dataset),HSIZE_T) + if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - if (present(parallel)) then - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif - 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_pInt,ext_msg='HDF5_write_real6: h5dwrite_f') - endif - - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) + 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_pInt,ext_msg='HDF5_write_real6: h5dwrite_f') + endif + + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_real6 @@ -1290,40 +1263,39 @@ end subroutine HDF5_write_real6 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_real7(loc_id,dataset,datasetName,parallel) - implicit none - real(pReal), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel + real(pReal), intent(inout), dimension(:,:,:,:,:,:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) + integer :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + myShape, & !< shape of the dataset (this process) + totalShape !< shape of the dataset (all processes) !--------------------------------------------------------------------------------------------------- ! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) + myShape = int(shape(dataset),HSIZE_T) + if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - if (present(parallel)) then - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,.false.) + endif - 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_pInt,ext_msg='HDF5_write_real7: h5dwrite_f') - endif - - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) + 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_pInt,ext_msg='HDF5_write_real7: h5dwrite_f') + endif + + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_real7 @@ -1333,40 +1305,39 @@ end subroutine HDF5_write_real7 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_int1(loc_id,dataset,datasetName,parallel) - implicit none - integer, intent(inout), dimension(:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel + integer, intent(inout), dimension(:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) + integer :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + myShape, & !< shape of the dataset (this process) + totalShape !< shape of the dataset (all processes) !--------------------------------------------------------------------------------------------------- ! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) + myShape = int(shape(dataset),HSIZE_T) + if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - if (present(parallel)) then - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif - 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_pInt,ext_msg='HDF5_write_int1: h5dwrite_f') - endif - - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) + 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_pInt,ext_msg='HDF5_write_int1: h5dwrite_f') + endif + + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_int1 @@ -1375,40 +1346,39 @@ end subroutine HDF5_write_int1 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_int2(loc_id,dataset,datasetName,parallel) - implicit none - integer, intent(inout), dimension(:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel + integer, intent(inout), dimension(:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) + integer :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + myShape, & !< shape of the dataset (this process) + totalShape !< shape of the dataset (all processes) !--------------------------------------------------------------------------------------------------- ! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) + myShape = int(shape(dataset),HSIZE_T) + if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - if (present(parallel)) then - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif - 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_pInt,ext_msg='HDF5_write_int2: h5dwrite_f') - endif + 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_pInt,ext_msg='HDF5_write_int2: h5dwrite_f') + endif - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_int2 @@ -1417,40 +1387,39 @@ end subroutine HDF5_write_int2 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_int3(loc_id,dataset,datasetName,parallel) - implicit none - integer, intent(inout), dimension(:,:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel + integer, intent(inout), dimension(:,:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) + integer :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + myShape, & !< shape of the dataset (this process) + totalShape !< shape of the dataset (all processes) !--------------------------------------------------------------------------------------------------- ! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) + myShape = int(shape(dataset),HSIZE_T) + if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - if (present(parallel)) then - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif - 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_pInt,ext_msg='HDF5_write_int3: h5dwrite_f') - endif - - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) + 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_pInt,ext_msg='HDF5_write_int3: h5dwrite_f') + endif + + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_int3 @@ -1459,40 +1428,39 @@ end subroutine HDF5_write_int3 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_int4(loc_id,dataset,datasetName,parallel) - implicit none - integer, intent(inout), dimension(:,:,:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel + integer, intent(inout), dimension(:,:,:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) + integer :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + myShape, & !< shape of the dataset (this process) + totalShape !< shape of the dataset (all processes) !--------------------------------------------------------------------------------------------------- ! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) + myShape = int(shape(dataset),HSIZE_T) + if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - if (present(parallel)) then - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif - 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_pInt,ext_msg='HDF5_write_int4: h5dwrite_f') - endif + 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_pInt,ext_msg='HDF5_write_int4: h5dwrite_f') + endif - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_int4 @@ -1501,40 +1469,39 @@ end subroutine HDF5_write_int4 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_int5(loc_id,dataset,datasetName,parallel) - implicit none - integer, intent(inout), dimension(:,:,:,:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel + integer, intent(inout), dimension(:,:,:,:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) + integer :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + myShape, & !< shape of the dataset (this process) + totalShape !< shape of the dataset (all processes) !--------------------------------------------------------------------------------------------------- ! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) + myShape = int(shape(dataset),HSIZE_T) + if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - if (present(parallel)) then - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif - 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_pInt,ext_msg='HDF5_write_int5: h5dwrite_f') - endif + 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_pInt,ext_msg='HDF5_write_int5: h5dwrite_f') + endif - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_int5 @@ -1543,40 +1510,39 @@ end subroutine HDF5_write_int5 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_int6(loc_id,dataset,datasetName,parallel) - implicit none - integer, intent(inout), dimension(:,:,:,:,:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel + integer, intent(inout), dimension(:,:,:,:,:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) + integer :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + myShape, & !< shape of the dataset (this process) + totalShape !< shape of the dataset (all processes) !--------------------------------------------------------------------------------------------------- ! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) + myShape = int(shape(dataset),HSIZE_T) + if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - if (present(parallel)) then - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif - 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_pInt,ext_msg='HDF5_write_int6: h5dwrite_f') - endif + 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_pInt,ext_msg='HDF5_write_int6: h5dwrite_f') + endif - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_int6 @@ -1585,40 +1551,39 @@ end subroutine HDF5_write_int6 !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_int7(loc_id,dataset,datasetName,parallel) - implicit none - integer, intent(inout), dimension(:,:,:,:,:,:,:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel + integer, intent(inout), dimension(:,:,:,:,:,:,:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer :: hdferr - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) + integer :: hdferr + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + myShape, & !< shape of the dataset (this process) + totalShape !< shape of the dataset (all processes) !--------------------------------------------------------------------------------------------------- ! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) - if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) + myShape = int(shape(dataset),HSIZE_T) + if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty) - if (present(parallel)) then - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) - else - call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & - myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) - endif + if (present(parallel)) then + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel) + else + call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & + myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,.false.) + endif - 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_pInt,ext_msg='HDF5_write_int7: h5dwrite_f') - endif + 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_pInt,ext_msg='HDF5_write_int7: h5dwrite_f') + endif - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_int7 @@ -1626,40 +1591,37 @@ end subroutine HDF5_write_int7 !-------------------------------------------------------------------------------------------------- !> @brief writes a scalar orientation dataset ! ToDo: It might be possible to write the dataset as a whole -! ToDo: We could add the crystal structure as an attribute +! ToDo: We could optionally write out other representations (axis angle, euler, ...) !-------------------------------------------------------------------------------------------------- subroutine HDF5_write_rotation(loc_id,dataset,datasetName,parallel) - use rotations - use numerics, only: & - worldrank, & - worldsize + use rotations, only: & + rotation - implicit none - type(rotation), intent(in), dimension(:) :: dataset - integer(HID_T), intent(in) :: loc_id !< file or group handle - character(len=*), intent(in) :: datasetName !< name of the dataset in the file - logical, intent(in), optional :: parallel + type(rotation), intent(in), dimension(:) :: dataset + integer(HID_T), intent(in) :: loc_id !< file or group handle + character(len=*), intent(in) :: datasetName !< name of the dataset in the file + logical, intent(in), optional :: parallel - integer :: hdferr - real(pReal), dimension(4,size(dataset)) :: dataset_asArray - integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id,dtype_id,w_id,x_id,y_id,z_id - integer(HSIZE_T), dimension(size(shape(dataset))) :: & - myStart, & - myShape, & !< shape of the dataset (this process) - totalShape !< shape of the dataset (all processes) - integer(SIZE_T) :: type_size_real - integer :: i + integer :: hdferr + real(pReal), dimension(4,size(dataset)) :: dataset_asArray + integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id,dtype_id,w_id,x_id,y_id,z_id + integer(HSIZE_T), dimension(size(shape(dataset))) :: & + myStart, & + myShape, & !< shape of the dataset (this process) + totalShape !< shape of the dataset (all processes) + integer(SIZE_T) :: type_size_real + integer :: i - do i = 1, size(dataset) - dataset_asArray(1:4,i) = dataset(i)%asQuaternion() - enddo + do i = 1, size(dataset) + dataset_asArray(1:4,i) = dataset(i)%asQuaternion() + enddo !--------------------------------------------------------------------------------------------------- ! determine shape of dataset - myShape = int(shape(dataset),HSIZE_T) + myShape = int(shape(dataset),HSIZE_T) !--------------------------------------------------------------------------------------------------- -! compound type: name of phase section + position/index within results array +! compound type: name of each quaternion component call h5tget_size_f(H5T_NATIVE_DOUBLE, type_size_real, hdferr) call h5tcreate_f(H5T_COMPOUND_F, type_size_real*4_SIZE_T, dtype_id, hdferr) @@ -1674,8 +1636,9 @@ subroutine HDF5_write_rotation(loc_id,dataset,datasetName,parallel) else call initialize_write(dset_id, filespace_id, memspace_id, plist_id, & myStart, totalShape, loc_id,myShape,datasetName,dtype_id,.false.) - endif - call h5pset_preserve_f(plist_id, .TRUE., hdferr) + endif + + call h5pset_preserve_f(plist_id, .TRUE., hdferr) if (product(totalShape) /= 0) then call h5tcreate_f(H5T_COMPOUND_F, type_size_real, x_id, hdferr) @@ -1687,18 +1650,18 @@ subroutine HDF5_write_rotation(loc_id,dataset,datasetName,parallel) call h5tcreate_f(H5T_COMPOUND_F, type_size_real, z_id, hdferr) call h5tinsert_f(z_id, "z", 0_SIZE_T, H5T_NATIVE_DOUBLE, hdferr) - call h5dwrite_f(dset_id, w_id,dataset_asArray(1,:),int(totalShape,HSIZE_T), hdferr,& - file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - call h5dwrite_f(dset_id, x_id,dataset_asArray(2,:),int(totalShape,HSIZE_T), hdferr,& - file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) - call h5dwrite_f(dset_id, y_id,dataset_asArray(3,:),int(totalShape,HSIZE_T), hdferr,& - 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_pInt,ext_msg='HDF5_write_rotation: h5dwrite_f') - endif + call h5dwrite_f(dset_id, w_id,dataset_asArray(1,:),int(totalShape,HSIZE_T), hdferr,& + file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) + call h5dwrite_f(dset_id, x_id,dataset_asArray(2,:),int(totalShape,HSIZE_T), hdferr,& + file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id) + call h5dwrite_f(dset_id, y_id,dataset_asArray(3,:),int(totalShape,HSIZE_T), hdferr,& + 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_pInt,ext_msg='HDF5_write_rotation: h5dwrite_f') + endif - call finalize_write(plist_id, dset_id, filespace_id, memspace_id) + call finalize_write(plist_id, dset_id, filespace_id, memspace_id) end subroutine HDF5_write_rotation @@ -1713,7 +1676,6 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_ worldrank, & worldsize - implicit none integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in) :: parallel @@ -1783,12 +1745,13 @@ end subroutine initialize_read !-------------------------------------------------------------------------------------------------- subroutine finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id) - implicit none integer(HID_T), intent(in) :: 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_pInt,ext_msg='finalize_read: plist_id') + call h5pclose_f(aplist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: aplist_id') call h5dclose_f(dset_id, hdferr) if (hdferr < 0) call IO_error(1_pInt,ext_msg='finalize_read: h5dclose_f') call h5sclose_f(filespace_id, hdferr) @@ -1809,7 +1772,6 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, & worldrank, & worldsize - implicit none integer(HID_T), intent(in) :: loc_id !< file or group handle character(len=*), intent(in) :: datasetName !< name of the dataset in the file logical, intent(in) :: parallel @@ -1874,7 +1836,6 @@ end subroutine initialize_write !-------------------------------------------------------------------------------------------------- subroutine finalize_write(plist_id, dset_id, filespace_id, memspace_id) - implicit none integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id integer :: hdferr diff --git a/src/results.f90 b/src/results.f90 index ce4105b73..4ed5cc751 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -47,7 +47,6 @@ subroutine results_init use DAMASK_interface, only: & getSolverJobName - implicit none character(len=pStringLen) :: commandLine write(6,'(/,a)') ' <<<+- results init -+>>>' @@ -76,7 +75,6 @@ subroutine results_openJobFile use DAMASK_interface, only: & getSolverJobName - implicit none resultsFile = HDF5_openFile(trim(getSolverJobName())//'.hdf5','a',.true.) @@ -87,7 +85,6 @@ end subroutine results_openJobFile !> @brief closes the results file !-------------------------------------------------------------------------------------------------- subroutine results_closeJobFile - implicit none call HDF5_closeFile(resultsFile) @@ -99,7 +96,6 @@ end subroutine results_closeJobFile !-------------------------------------------------------------------------------------------------- subroutine results_addIncrement(inc,time) - implicit none integer(pInt), intent(in) :: inc real(pReal), intent(in) :: time character(len=pStringLen) :: incChar @@ -116,7 +112,6 @@ end subroutine results_addIncrement !-------------------------------------------------------------------------------------------------- integer(HID_T) function results_openGroup(groupName) - implicit none character(len=*), intent(in) :: groupName results_openGroup = HDF5_openGroup(resultsFile,groupName) @@ -129,7 +124,6 @@ end function results_openGroup !-------------------------------------------------------------------------------------------------- integer(HID_T) function results_addGroup(groupName) - implicit none character(len=*), intent(in) :: groupName results_addGroup = HDF5_addGroup(resultsFile,groupName) @@ -142,7 +136,6 @@ end function results_addGroup !-------------------------------------------------------------------------------------------------- subroutine results_setLink(path,link) - implicit none character(len=*), intent(in) :: path, link call HDF5_setLink(resultsFile,path,link) @@ -155,7 +148,6 @@ end subroutine results_setLink !-------------------------------------------------------------------------------------------------- subroutine results_addAttribute(attrLabel,attrValue,path) - implicit none character(len=*), intent(in) :: attrLabel, attrValue, path call HDF5_addAttribute_str(resultsFile,attrLabel, attrValue, path) @@ -168,7 +160,6 @@ end subroutine results_addAttribute !-------------------------------------------------------------------------------------------------- subroutine results_removeLink(link) - implicit none character(len=*), intent(in) :: link integer :: hdferr @@ -183,7 +174,6 @@ end subroutine results_removeLink !-------------------------------------------------------------------------------------------------- subroutine results_writeScalarDataset_real(group,dataset,label,description,SIunit) - implicit none character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit real(pReal), intent(inout), dimension(:) :: dataset @@ -209,7 +199,6 @@ end subroutine results_writeScalarDataset_real !-------------------------------------------------------------------------------------------------- subroutine results_writeVectorDataset_real(group,dataset,label,description,SIunit) - implicit none character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit real(pReal), intent(inout), dimension(:,:) :: dataset @@ -236,7 +225,6 @@ end subroutine results_writeVectorDataset_real !-------------------------------------------------------------------------------------------------- subroutine results_writeTensorDataset_real(group,dataset,label,description,SIunit) - implicit none character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit real(pReal), intent(inout), dimension(:,:,:) :: dataset @@ -263,7 +251,6 @@ end subroutine results_writeTensorDataset_real !-------------------------------------------------------------------------------------------------- subroutine results_writeVectorDataset_int(group,dataset,label,description,SIunit) - implicit none character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit integer, intent(inout), dimension(:,:) :: dataset @@ -290,7 +277,6 @@ end subroutine results_writeVectorDataset_int !-------------------------------------------------------------------------------------------------- subroutine results_writeTensorDataset_int(group,dataset,label,description,SIunit) - implicit none character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit integer, intent(inout), dimension(:,:,:) :: dataset @@ -315,11 +301,10 @@ end subroutine results_writeTensorDataset_int !-------------------------------------------------------------------------------------------------- !> @brief stores a vector dataset in a group !-------------------------------------------------------------------------------------------------- -subroutine results_writeScalarDataset_rotation(group,dataset,label,description,SIunit) +subroutine results_writeScalarDataset_rotation(group,dataset,label,description,lattice_structure) use rotations, only: & rotation - implicit none character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: lattice_structure type(rotation), intent(inout), dimension(:) :: dataset @@ -413,30 +398,30 @@ subroutine results_mapping_constituent(phaseAt,memberAt,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 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') - - 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') + 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 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') + + 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') #endif - myShape = int([size(phaseAt,1),writeSize(worldrank)], HSIZE_T) - myOffset = int([0,sum(writeSize(0:worldrank-1))], HSIZE_T) - totalShape = int([size(phaseAt,1),sum(writeSize)], HSIZE_T) + myShape = int([size(phaseAt,1),writeSize(worldrank)], HSIZE_T) + myOffset = int([0,sum(writeSize(0:worldrank-1))], HSIZE_T) + totalShape = int([size(phaseAt,1),sum(writeSize)], HSIZE_T) !-------------------------------------------------------------------------------------------------- ! 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,totalShape,filespace_id,ierr,totalShape) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_constituent: h5screate_simple_f/filespace_id') - - 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 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,totalShape,filespace_id,ierr,totalShape) + if (ierr < 0) call IO_error(1,ext_msg='results_mapping_constituent: h5screate_simple_f/filespace_id') + + 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') !--------------------------------------------------------------------------------------------------- ! expand phaseAt to consider IPs (is not stored per IP) @@ -452,29 +437,29 @@ subroutine results_mapping_constituent(phaseAt,memberAt,label) !-------------------------------------------------------------------------------------------------- ! write the components of the compound type individually - call h5pset_preserve_f(plist_id, .TRUE., ierr) - - loc_id = results_openGroup('/mapping/cellResults') - call h5dcreate_f(loc_id, 'constituent', dtype_id, filespace_id, dset_id, ierr) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_constituent: h5dcreate_f') - - call h5dwrite_f(dset_id, name_id, reshape(label(pack(phaseAt_perIP,.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') - call h5dwrite_f(dset_id, position_id, reshape(pack(memberAt_total,.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') + call h5pset_preserve_f(plist_id, .TRUE., ierr) + + loc_id = results_openGroup('/mapping/cellResults') + call h5dcreate_f(loc_id, 'constituent', dtype_id, filespace_id, dset_id, ierr) + if (ierr < 0) call IO_error(1,ext_msg='results_mapping_constituent: h5dcreate_f') + + call h5dwrite_f(dset_id, name_id, reshape(label(pack(phaseAt_perIP,.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') + call h5dwrite_f(dset_id, position_id, reshape(pack(memberAt_total,.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') !-------------------------------------------------------------------------------------------------- ! 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 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) end subroutine results_mapping_constituent @@ -551,30 +536,30 @@ subroutine results_mapping_materialpoint(homogenizationAt,memberAt,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_materialpoint: h5pset_dxpl_mpio_f') - - 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_materialpoint: MPI_allreduce/writeSize') - - 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_materialpoint: MPI_allreduce/memberOffset') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, ierr) + if (ierr < 0) call IO_error(1,ext_msg='results_mapping_materialpoint: h5pset_dxpl_mpio_f') + + 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_materialpoint: MPI_allreduce/writeSize') + + 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_materialpoint: MPI_allreduce/memberOffset') #endif - myShape = int([writeSize(worldrank)], HSIZE_T) - myOffset = int([sum(writeSize(0:worldrank-1))], HSIZE_T) - totalShape = int([sum(writeSize)], HSIZE_T) + myShape = int([writeSize(worldrank)], HSIZE_T) + myOffset = int([sum(writeSize(0:worldrank-1))], HSIZE_T) + totalShape = int([sum(writeSize)], HSIZE_T) !-------------------------------------------------------------------------------------------------- ! 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_materialpoint: h5screate_simple_f/memspace_id') - - call h5screate_simple_f(1,totalShape,filespace_id,ierr,totalShape) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_materialpoint: h5screate_simple_f/filespace_id') - - call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, ierr) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_materialpoint: h5sselect_hyperslab_f') + call h5screate_simple_f(1,myShape,memspace_id,ierr,myShape) + if (ierr < 0) call IO_error(1,ext_msg='results_mapping_materialpoint: h5screate_simple_f/memspace_id') + + call h5screate_simple_f(1,totalShape,filespace_id,ierr,totalShape) + if (ierr < 0) call IO_error(1,ext_msg='results_mapping_materialpoint: h5screate_simple_f/filespace_id') + + call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, ierr) + if (ierr < 0) call IO_error(1,ext_msg='results_mapping_materialpoint: h5sselect_hyperslab_f') !--------------------------------------------------------------------------------------------------- ! expand phaseAt to consider IPs (is not stored per IP) @@ -590,29 +575,29 @@ subroutine results_mapping_materialpoint(homogenizationAt,memberAt,label) !-------------------------------------------------------------------------------------------------- ! write the components of the compound type individually - call h5pset_preserve_f(plist_id, .TRUE., ierr) - - loc_id = results_openGroup('/mapping/cellResults') - call h5dcreate_f(loc_id, 'materialpoint', dtype_id, filespace_id, dset_id, ierr) - if (ierr < 0) call IO_error(1,ext_msg='results_mapping_materialpoint: h5dcreate_f') - - call h5dwrite_f(dset_id, name_id, reshape(label(pack(homogenizationAt_perIP,.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_materialpoint: h5dwrite_f/name_id') - call h5dwrite_f(dset_id, position_id, reshape(pack(memberAt_total,.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_materialpoint: h5dwrite_f/position_id') + call h5pset_preserve_f(plist_id, .TRUE., ierr) + + loc_id = results_openGroup('/mapping/cellResults') + call h5dcreate_f(loc_id, 'materialpoint', dtype_id, filespace_id, dset_id, ierr) + if (ierr < 0) call IO_error(1,ext_msg='results_mapping_materialpoint: h5dcreate_f') + + call h5dwrite_f(dset_id, name_id, reshape(label(pack(homogenizationAt_perIP,.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_materialpoint: h5dwrite_f/name_id') + call h5dwrite_f(dset_id, position_id, reshape(pack(memberAt_total,.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_materialpoint: h5dwrite_f/position_id') !-------------------------------------------------------------------------------------------------- ! 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 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) end subroutine results_mapping_materialpoint @@ -623,7 +608,6 @@ end subroutine results_mapping_materialpoint !subroutine HDF5_backwardMappingPhase(material_phase,phasememberat,phase_name,dataspace_size,mpiOffset,mpiOffset_phase) ! use hdf5 -! implicit none ! integer(pInt), intent(in), dimension(:,:,:) :: material_phase, phasememberat ! character(len=*), intent(in), dimension(:) :: phase_name ! integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_phase @@ -738,7 +722,6 @@ end subroutine results_mapping_materialpoint !subroutine HDF5_backwardMappingHomog(material_homog,homogmemberat,homogenization_name,dataspace_size,mpiOffset,mpiOffset_homog) ! use hdf5 -! implicit none ! integer(pInt), intent(in), dimension(:,:) :: material_homog, homogmemberat ! character(len=*), intent(in), dimension(:) :: homogenization_name ! integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_homog @@ -846,7 +829,6 @@ end subroutine results_mapping_materialpoint !subroutine HDF5_mappingCells(mapping) ! use hdf5 -! implicit none ! integer(pInt), intent(in), dimension(:) :: mapping ! integer :: hdferr, Nnodes