!-------------------------------------------------------------------------------------------------- !> @author Vitesh Shah, Max-Planck-Institut für Eisenforschung GmbH !> @author Yi-Chin Yang, Max-Planck-Institut für Eisenforschung GmbH !> @author Jennifer Nastola, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !-------------------------------------------------------------------------------------------------- module results use DAMASK_interface use parallelization use rotations use HDF5_utilities #ifdef PETSc use PETSC #endif implicit none private integer(HID_T) :: resultsFile interface results_writeDataset module procedure results_writeTensorDataset_real module procedure results_writeVectorDataset_real module procedure results_writeScalarDataset_real module procedure results_writeTensorDataset_int module procedure results_writeVectorDataset_int module procedure results_writeScalarDataset_rotation end interface results_writeDataset interface results_addAttribute module procedure results_addAttribute_real module procedure results_addAttribute_int module procedure results_addAttribute_str module procedure results_addAttribute_int_array module procedure results_addAttribute_real_array end interface results_addAttribute public :: & results_init, & results_openJobFile, & results_closeJobFile, & results_addIncrement, & results_finalizeIncrement, & results_addGroup, & results_openGroup, & results_closeGroup, & results_writeDataset, & results_setLink, & results_addAttribute, & results_removeLink, & results_mapping_constituent, & results_mapping_homogenization contains subroutine results_init(restart) logical, intent(in) :: restart character(len=pStringLen) :: commandLine print'(/,a)', ' <<<+- results init -+>>>'; flush(IO_STDOUT) print*, 'Diehl et al., Integrating Materials and Manufacturing Innovation 6(1):83–91, 2017' print*, 'https://doi.org/10.1007/s40192-017-0084-5'//IO_EOL if(.not. restart) then resultsFile = HDF5_openFile(trim(getSolverJobName())//'.hdf5','w',.true.) call results_addAttribute('DADF5_version_major',0) call results_addAttribute('DADF5_version_minor',7) call results_addAttribute('DAMASK_version',DAMASKVERSION) call get_command(commandLine) call results_addAttribute('call',trim(commandLine)) call results_closeGroup(results_addGroup('mapping')) call results_closeGroup(results_addGroup('mapping/cellResults')) call results_closeJobFile endif end subroutine results_init !-------------------------------------------------------------------------------------------------- !> @brief opens the results file to append data !-------------------------------------------------------------------------------------------------- subroutine results_openJobFile resultsFile = HDF5_openFile(trim(getSolverJobName())//'.hdf5','a',.true.) end subroutine results_openJobFile !-------------------------------------------------------------------------------------------------- !> @brief closes the results file !-------------------------------------------------------------------------------------------------- subroutine results_closeJobFile call HDF5_closeFile(resultsFile) end subroutine results_closeJobFile !-------------------------------------------------------------------------------------------------- !> @brief creates the group of increment and adds time as attribute to the file !-------------------------------------------------------------------------------------------------- subroutine results_addIncrement(inc,time) integer, intent(in) :: inc real(pReal), intent(in) :: time character(len=pStringLen) :: incChar write(incChar,'(i10)') inc call results_closeGroup(results_addGroup(trim('inc'//trim(adjustl(incChar))))) call results_setLink(trim('inc'//trim(adjustl(incChar))),'current') call results_addAttribute('time/s',time,trim('inc'//trim(adjustl(incChar)))) call results_closeGroup(results_addGroup('current/phase')) call results_closeGroup(results_addGroup('current/homogenization')) ! for backward compatibility call results_setLink(trim('/inc'//trim(adjustl(incChar)))//'/phase',& trim('/inc'//trim(adjustl(incChar)))//'/constituent') call results_setLink(trim('/inc'//trim(adjustl(incChar)))//'/homogenization',& trim('/inc'//trim(adjustl(incChar)))//'/materialpoint') end subroutine results_addIncrement !-------------------------------------------------------------------------------------------------- !> @brief finalize increment !> @details remove soft link !-------------------------------------------------------------------------------------------------- subroutine results_finalizeIncrement call results_removeLink('current') end subroutine results_finalizeIncrement !-------------------------------------------------------------------------------------------------- !> @brief open a group from the results file !-------------------------------------------------------------------------------------------------- integer(HID_T) function results_openGroup(groupName) character(len=*), intent(in) :: groupName results_openGroup = HDF5_openGroup(resultsFile,groupName) end function results_openGroup !-------------------------------------------------------------------------------------------------- !> @brief adds a new group to the results file !-------------------------------------------------------------------------------------------------- integer(HID_T) function results_addGroup(groupName) character(len=*), intent(in) :: groupName results_addGroup = HDF5_addGroup(resultsFile,groupName) end function results_addGroup !-------------------------------------------------------------------------------------------------- !> @brief close a group !-------------------------------------------------------------------------------------------------- subroutine results_closeGroup(group_id) integer(HID_T), intent(in) :: group_id call HDF5_closeGroup(group_id) end subroutine results_closeGroup !-------------------------------------------------------------------------------------------------- !> @brief set link to object in results file !-------------------------------------------------------------------------------------------------- subroutine results_setLink(path,link) character(len=*), intent(in) :: path, link call HDF5_setLink(resultsFile,path,link) end subroutine results_setLink !-------------------------------------------------------------------------------------------------- !> @brief adds a string attribute to an object in the results file !-------------------------------------------------------------------------------------------------- subroutine results_addAttribute_str(attrLabel,attrValue,path) character(len=*), intent(in) :: attrLabel, attrValue character(len=*), intent(in), optional :: path if (present(path)) then call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path) else call HDF5_addAttribute(resultsFile,attrLabel, attrValue) endif end subroutine results_addAttribute_str !-------------------------------------------------------------------------------------------------- !> @brief adds an integer attribute an object in the results file !-------------------------------------------------------------------------------------------------- subroutine results_addAttribute_int(attrLabel,attrValue,path) character(len=*), intent(in) :: attrLabel integer, intent(in) :: attrValue character(len=*), intent(in), optional :: path if (present(path)) then call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path) else call HDF5_addAttribute(resultsFile,attrLabel, attrValue) endif end subroutine results_addAttribute_int !-------------------------------------------------------------------------------------------------- !> @brief adds a real attribute an object in the results file !-------------------------------------------------------------------------------------------------- subroutine results_addAttribute_real(attrLabel,attrValue,path) character(len=*), intent(in) :: attrLabel real(pReal), intent(in) :: attrValue character(len=*), intent(in), optional :: path if (present(path)) then call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path) else call HDF5_addAttribute(resultsFile,attrLabel, attrValue) endif end subroutine results_addAttribute_real !-------------------------------------------------------------------------------------------------- !> @brief adds an integer array attribute an object in the results file !-------------------------------------------------------------------------------------------------- subroutine results_addAttribute_int_array(attrLabel,attrValue,path) character(len=*), intent(in) :: attrLabel integer, intent(in), dimension(:) :: attrValue character(len=*), intent(in), optional :: path if (present(path)) then call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path) else call HDF5_addAttribute(resultsFile,attrLabel, attrValue) endif end subroutine results_addAttribute_int_array !-------------------------------------------------------------------------------------------------- !> @brief adds a real array attribute an object in the results file !-------------------------------------------------------------------------------------------------- subroutine results_addAttribute_real_array(attrLabel,attrValue,path) character(len=*), intent(in) :: attrLabel real(pReal), intent(in), dimension(:) :: attrValue character(len=*), intent(in), optional :: path if (present(path)) then call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path) else call HDF5_addAttribute(resultsFile,attrLabel, attrValue) endif end subroutine results_addAttribute_real_array !-------------------------------------------------------------------------------------------------- !> @brief remove link to an object !-------------------------------------------------------------------------------------------------- subroutine results_removeLink(link) character(len=*), intent(in) :: link integer :: hdferr call h5ldelete_f(resultsFile,link, hdferr) if (hdferr < 0) call IO_error(1,ext_msg = 'results_removeLink: h5ldelete_soft_f ('//trim(link)//')') end subroutine results_removeLink !-------------------------------------------------------------------------------------------------- !> @brief stores a scalar dataset in a group !-------------------------------------------------------------------------------------------------- subroutine results_writeScalarDataset_real(group,dataset,label,description,SIunit) character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit real(pReal), intent(inout), dimension(:) :: dataset integer(HID_T) :: groupHandle groupHandle = results_openGroup(group) #ifdef PETSc call HDF5_write(groupHandle,dataset,label,.true.) #else call HDF5_write(groupHandle,dataset,label,.false.) #endif if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Description',description,label) if (HDF5_objectExists(groupHandle,label) .and. present(SIunit)) & call HDF5_addAttribute(groupHandle,'Unit',SIunit,label) if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Creator','DAMASK '//DAMASKVERSION,label) if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Created',now(),label) call HDF5_closeGroup(groupHandle) end subroutine results_writeScalarDataset_real !-------------------------------------------------------------------------------------------------- !> @brief stores a vector dataset in a group !-------------------------------------------------------------------------------------------------- subroutine results_writeVectorDataset_real(group,dataset,label,description,SIunit) character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit real(pReal), intent(inout), dimension(:,:) :: dataset integer(HID_T) :: groupHandle groupHandle = results_openGroup(group) #ifdef PETSc call HDF5_write(groupHandle,dataset,label,.true.) #else call HDF5_write(groupHandle,dataset,label,.false.) #endif if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Description',description,label) if (HDF5_objectExists(groupHandle,label) .and. present(SIunit)) & call HDF5_addAttribute(groupHandle,'Unit',SIunit,label) if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Creator','DAMASK '//DAMASKVERSION,label) if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Created',now(),label) call HDF5_closeGroup(groupHandle) end subroutine results_writeVectorDataset_real !-------------------------------------------------------------------------------------------------- !> @brief stores a tensor dataset in a group !-------------------------------------------------------------------------------------------------- subroutine results_writeTensorDataset_real(group,dataset,label,description,SIunit,transposed) character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit logical, intent(in), optional :: transposed real(pReal), intent(in), dimension(:,:,:) :: dataset integer :: i logical :: transposed_ integer(HID_T) :: groupHandle real(pReal), dimension(:,:,:), allocatable :: dataset_transposed if(present(transposed)) then transposed_ = transposed else transposed_ = .true. endif if(transposed_) then if(size(dataset,1) /= size(dataset,2)) call IO_error(0,ext_msg='transpose non-symmetric tensor') allocate(dataset_transposed,mold=dataset) do i=1,size(dataset_transposed,3) dataset_transposed(:,:,i) = transpose(dataset(:,:,i)) enddo else allocate(dataset_transposed,source=dataset) endif groupHandle = results_openGroup(group) #ifdef PETSc call HDF5_write(groupHandle,dataset_transposed,label,.true.) #else call HDF5_write(groupHandle,dataset_transposed,label,.false.) #endif if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Description',description,label) if (HDF5_objectExists(groupHandle,label) .and. present(SIunit)) & call HDF5_addAttribute(groupHandle,'Unit',SIunit,label) if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Creator','DAMASK '//DAMASKVERSION,label) if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Created',now(),label) call HDF5_closeGroup(groupHandle) end subroutine results_writeTensorDataset_real !-------------------------------------------------------------------------------------------------- !> @brief stores a vector dataset in a group !-------------------------------------------------------------------------------------------------- subroutine results_writeVectorDataset_int(group,dataset,label,description,SIunit) character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit integer, intent(inout), dimension(:,:) :: dataset integer(HID_T) :: groupHandle groupHandle = results_openGroup(group) #ifdef PETSc call HDF5_write(groupHandle,dataset,label,.true.) #else call HDF5_write(groupHandle,dataset,label,.false.) #endif if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Description',description,label) if (HDF5_objectExists(groupHandle,label) .and. present(SIunit)) & call HDF5_addAttribute(groupHandle,'Unit',SIunit,label) if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Creator','DAMASK '//DAMASKVERSION,label) if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Created',now(),label) call HDF5_closeGroup(groupHandle) end subroutine results_writeVectorDataset_int !-------------------------------------------------------------------------------------------------- !> @brief stores a tensor dataset in a group !-------------------------------------------------------------------------------------------------- subroutine results_writeTensorDataset_int(group,dataset,label,description,SIunit) character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit integer, intent(inout), dimension(:,:,:) :: dataset integer(HID_T) :: groupHandle groupHandle = results_openGroup(group) #ifdef PETSc call HDF5_write(groupHandle,dataset,label,.true.) #else call HDF5_write(groupHandle,dataset,label,.false.) #endif if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Description',description,label) if (HDF5_objectExists(groupHandle,label) .and. present(SIunit)) & call HDF5_addAttribute(groupHandle,'Unit',SIunit,label) if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Creator','DAMASK '//DAMASKVERSION,label) if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Created',now(),label) call HDF5_closeGroup(groupHandle) end subroutine results_writeTensorDataset_int !-------------------------------------------------------------------------------------------------- !> @brief stores a scalar dataset in a group !-------------------------------------------------------------------------------------------------- subroutine results_writeScalarDataset_rotation(group,dataset,label,description,lattice_structure) character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: lattice_structure type(rotation), intent(inout), dimension(:) :: dataset integer(HID_T) :: groupHandle groupHandle = results_openGroup(group) #ifdef PETSc call HDF5_write(groupHandle,dataset,label,.true.) #else call HDF5_write(groupHandle,dataset,label,.false.) #endif if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Description',description,label) if (HDF5_objectExists(groupHandle,label) .and. present(lattice_structure)) & call HDF5_addAttribute(groupHandle,'Lattice',lattice_structure,label) if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Creator','DAMASK '//DAMASKVERSION,label) if (HDF5_objectExists(groupHandle,label)) & call HDF5_addAttribute(groupHandle,'Created',now(),label) call HDF5_closeGroup(groupHandle) end subroutine results_writeScalarDataset_rotation !-------------------------------------------------------------------------------------------------- !> @brief adds the unique mapping from spatial position and constituent ID to results !-------------------------------------------------------------------------------------------------- subroutine results_mapping_constituent(phaseAt,memberAtLocal,label) integer, dimension(:,:), intent(in) :: phaseAt !< phase section at (constituent,element) integer, dimension(:,:,:), intent(in) :: memberAtLocal !< phase member at (constituent,IP,element) character(len=pStringLen), dimension(:), intent(in) :: label !< label of each phase section integer, dimension(size(memberAtLocal,1),size(memberAtLocal,2),size(memberAtLocal,3)) :: & phaseAtMaterialpoint, & memberAtGlobal integer, dimension(size(label),0:worldsize-1) :: memberOffset !< offset in member counting per process integer, dimension(0:worldsize-1) :: writeSize !< amount of data written per process integer(HSIZE_T), dimension(2) :: & myShape, & !< shape of the dataset (this process) myOffset, & totalShape !< shape of the dataset (all processes) integer(HID_T) :: & loc_id, & !< identifier of group in file dtype_id, & !< identifier of compound data type name_id, & !< identifier of name (string) in compound data type position_id, & !< identifier of position/index (integer) in compound data type dset_id, & memspace_id, & filespace_id, & plist_id, & dt_id integer(SIZE_T) :: type_size_string, type_size_int integer :: 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 h5tget_size_f(H5T_NATIVE_INTEGER, type_size_int, ierr) 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) !-------------------------------------------------------------------------------------------------- ! 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_int, position_id, ierr) call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_NATIVE_INTEGER, ierr) call h5tclose_f(dt_id, ierr) !-------------------------------------------------------------------------------------------------- ! prepare MPI communication (transparent for non-MPI runs) call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, ierr) memberOffset = 0 do i=1, size(label) memberOffset(i,worldrank) = count(phaseAt == i)*size(memberAtLocal,2) ! number of points/instance of this process enddo writeSize = 0 writeSize(worldrank) = size(memberAtLocal(1,:,:)) ! 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_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) !-------------------------------------------------------------------------------------------------- ! 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') !--------------------------------------------------------------------------------------------------- ! expand phaseAt to consider IPs (is not stored per IP) do i = 1, size(phaseAtMaterialpoint,2) phaseAtMaterialpoint(:,i,:) = phaseAt enddo !--------------------------------------------------------------------------------------------------- ! renumber member from my process to all processes do i = 1, size(label) where(phaseAtMaterialpoint == i) memberAtGlobal = memberAtLocal + sum(memberOffset(i,0:worldrank-1)) -1 ! convert to 0-based enddo !-------------------------------------------------------------------------------------------------- ! write the components of the compound type individually call h5pset_preserve_f(plist_id, .TRUE., ierr) 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 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') 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') !-------------------------------------------------------------------------------------------------- ! 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) ! for backward compatibility call results_setLink('/mapping/phase','/mapping/cellResults/constituent') end subroutine results_mapping_constituent !-------------------------------------------------------------------------------------------------- !> @brief adds the unique mapping from spatial position and constituent ID to results !-------------------------------------------------------------------------------------------------- subroutine results_mapping_homogenization(homogenizationAt,memberAtLocal,label) integer, dimension(:), intent(in) :: homogenizationAt !< homogenization section at (element) integer, dimension(:,:), intent(in) :: memberAtLocal !< homogenization member at (IP,element) character(len=pStringLen), dimension(:), intent(in) :: label !< label of each homogenization section integer, dimension(size(memberAtLocal,1),size(memberAtLocal,2)) :: & homogenizationAtMaterialpoint, & memberAtGlobal integer, dimension(size(label),0:worldsize-1) :: memberOffset !< offset in member counting per process integer, dimension(0:worldsize-1) :: writeSize !< amount of data written per process integer(HSIZE_T), dimension(1) :: & myShape, & !< shape of the dataset (this process) myOffset, & totalShape !< shape of the dataset (all processes) integer(HID_T) :: & loc_id, & !< identifier of group in file dtype_id, & !< identifier of compound data type name_id, & !< identifier of name (string) in compound data type position_id, & !< identifier of position/index (integer) in compound data type dset_id, & memspace_id, & filespace_id, & plist_id, & dt_id integer(SIZE_T) :: type_size_string, type_size_int integer :: 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 h5tget_size_f(H5T_NATIVE_INTEGER, type_size_int, ierr) 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) !-------------------------------------------------------------------------------------------------- ! 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_int, position_id, ierr) call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_NATIVE_INTEGER, ierr) call h5tclose_f(dt_id, ierr) !-------------------------------------------------------------------------------------------------- ! prepare MPI communication (transparent for non-MPI runs) call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, ierr) memberOffset = 0 do i=1, size(label) 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 !-------------------------------------------------------------------------------------------------- ! 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 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') 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') #endif 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_homogenization: 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_homogenization: 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_homogenization: h5sselect_hyperslab_f') !--------------------------------------------------------------------------------------------------- ! expand phaseAt to consider IPs (is not stored per IP) do i = 1, size(homogenizationAtMaterialpoint,1) homogenizationAtMaterialpoint(i,:) = homogenizationAt enddo !--------------------------------------------------------------------------------------------------- ! renumber member from my process to all processes do i = 1, size(label) where(homogenizationAtMaterialpoint == i) memberAtGlobal = memberAtLocal + sum(memberOffset(i,0:worldrank-1)) - 1 ! convert to 0-based enddo !-------------------------------------------------------------------------------------------------- ! write the components of the compound type individually call h5pset_preserve_f(plist_id, .TRUE., ierr) 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 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') 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') !-------------------------------------------------------------------------------------------------- ! 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) ! for backward compatibility call results_setLink('/mapping/homogenization','/mapping/cellResults/materialpoint') end subroutine results_mapping_homogenization !-------------------------------------------------------------------------------------------------- !> @brief current date and time (including time zone information) !-------------------------------------------------------------------------------------------------- character(len=24) function now() character(len=5) :: zone integer, dimension(8) :: values call date_and_time(values=values,zone=zone) write(now,'(i4.4,5(a,i2.2),a)') & values(1),'-',values(2),'-',values(3),' ',values(5),':',values(6),':',values(7),zone end function now !!-------------------------------------------------------------------------------------------------- !!> @brief adds the backward mapping from spatial position and constituent ID to results !!-------------------------------------------------------------------------------------------------- !subroutine HDF5_backwardMappingPhase(material_phase,phasememberat,phase_name,dataspace_size,mpiOffset,mpiOffset_phase) ! integer(pInt), intent(in), dimension(:,:,:) :: material_phase, phasememberat ! character(len=*), intent(in), dimension(:) :: phase_name ! integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_phase ! integer(pInt), intent(in) :: mpiOffset ! integer(pInt) :: hdferr, NmatPoints, Nconstituents, i, j ! integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace ! integer(SIZE_T) :: type_size ! integer(pInt), dimension(:,:), allocatable :: arr ! integer(HSIZE_T), dimension(1) :: counter ! integer(HSSIZE_T), dimension(1) :: fileOffset ! character(len=64) :: phaseID ! Nconstituents = size(phasememberat,1) ! NmatPoints = count(material_phase /=0)/Nconstituents ! allocate(arr(2,NmatPoints*Nconstituents)) ! do i=1, NmatPoints ! do j=Nconstituents-1, 0, -1 ! arr(1,Nconstituents*i-j) = i-1 ! enddo ! enddo ! arr(2,:) = pack(material_phase,material_phase/=0) ! do i=1, size(phase_name) ! write(phaseID, '(i0)') i ! mapping_ID = results_openGroup('/current/constitutive/'//trim(phaseID)//'_'//phase_name(i)) ! NmatPoints = count(material_phase == i) !!-------------------------------------------------------------------------------------------------- ! ! create dataspace ! call h5screate_simple_f(1, int([dataspace_size(i)],HSIZE_T), space_id, hdferr, & ! int([dataspace_size(i)],HSIZE_T)) ! if (hdferr < 0) call IO_error(1,ext_msg='HDF5_writeBackwardMapping') !!-------------------------------------------------------------------------------------------------- ! ! compound type ! call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr) ! call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id') ! call h5tinsert_f(dtype_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingPhase: h5tinsert_f 0') !!-------------------------------------------------------------------------------------------------- ! ! create Dataset ! call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingPhase') !!-------------------------------------------------------------------------------------------------- ! ! Create memory types (one compound datatype for each member) ! call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingPhase: h5tcreate_f position_id') ! call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingPhase: h5tinsert_f position_id') !!-------------------------------------------------------------------------------------------------- ! ! Define and select hyperslabs ! counter = NmatPoints ! how big i am ! fileOffset = mpiOffset_phase(i) ! where i start to write my data ! call h5screate_simple_f(1, counter, memspace, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingPhase: h5screate_simple_f') ! call h5dget_space_f(dset_id, space_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingPhase: h5dget_space_f') ! call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingPhase: h5sselect_hyperslab_f') !!-------------------------------------------------------------------------------------------------- ! ! Create property list for collective dataset write !#ifdef PETSc ! call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingPhase: h5pcreate_f') ! call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingPhase: h5pset_dxpl_mpio_f') !#endif !!-------------------------------------------------------------------------------------------------- ! ! write data by fields in the datatype. Fields order is not important. ! call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i)+mpiOffset, int([dataspace_size(i)],HSIZE_T),& ! hdferr, file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingPhase: h5dwrite_f instance_id') !!-------------------------------------------------------------------------------------------------- ! !close types, dataspaces ! call h5tclose_f(dtype_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingPhase: h5tclose_f dtype_id') ! call h5tclose_f(position_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingPhase: h5tclose_f position_id') ! call h5dclose_f(dset_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingPhase: h5dclose_f') ! call h5sclose_f(space_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingPhase: h5sclose_f space_id') ! call h5sclose_f(memspace, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingPhase: h5sclose_f memspace') ! call h5pclose_f(plist_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingPhase: h5pclose_f') ! call HDF5_closeGroup(mapping_ID) ! enddo !end subroutine HDF5_backwardMappingPhase !!-------------------------------------------------------------------------------------------------- !!> @brief adds the backward mapping from spatial position and constituent ID to results !!-------------------------------------------------------------------------------------------------- !subroutine HDF5_backwardMappingHomog(material_homog,homogmemberat,homogenization_name,dataspace_size,mpiOffset,mpiOffset_homog) ! integer(pInt), intent(in), dimension(:,:) :: material_homog, homogmemberat ! character(len=*), intent(in), dimension(:) :: homogenization_name ! integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_homog ! integer(pInt), intent(in) :: mpiOffset ! integer(pInt) :: hdferr, NmatPoints, i ! integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace ! integer(SIZE_T) :: type_size ! integer(pInt), dimension(:,:), allocatable :: arr ! integer(HSIZE_T), dimension(1) :: counter ! integer(HSSIZE_T), dimension(1) :: fileOffset ! character(len=64) :: homogID ! NmatPoints = count(material_homog /=0) ! allocate(arr(2,NmatPoints)) ! arr(1,:) = (/(i, i=0,NmatPoints-1)/) ! arr(2,:) = pack(material_homog,material_homog/=0) ! do i=1, size(homogenization_name) ! write(homogID, '(i0)') i ! mapping_ID = results_openGroup('/current/homogenization/'//trim(homogID)//'_'//homogenization_name(i)) !!-------------------------------------------------------------------------------------------------- ! ! create dataspace ! call h5screate_simple_f(1, int([dataspace_size(i)],HSIZE_T), space_id, hdferr, & ! int([dataspace_size(i)],HSIZE_T)) ! if (hdferr < 0) call IO_error(1,ext_msg='HDF5_writeBackwardMapping') !!-------------------------------------------------------------------------------------------------- ! ! compound type ! call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr) ! call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id') ! call h5tinsert_f(dtype_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingHomog: h5tinsert_f 0') !!-------------------------------------------------------------------------------------------------- ! ! create Dataset ! call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingHomog') !!-------------------------------------------------------------------------------------------------- ! ! Create memory types (one compound datatype for each member) ! call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingHomog: h5tcreate_f position_id') ! call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingHomog: h5tinsert_f position_id') !!-------------------------------------------------------------------------------------------------- ! ! Define and select hyperslabs ! counter = NmatPoints ! how big i am ! fileOffset = mpiOffset_homog(i) ! where i start to write my data ! call h5screate_simple_f(1, counter, memspace, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingHomog: h5screate_simple_f') ! call h5dget_space_f(dset_id, space_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingHomog: h5dget_space_f') ! call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingHomog: h5sselect_hyperslab_f') !!-------------------------------------------------------------------------------------------------- ! ! Create property list for collective dataset write !#ifdef PETSc ! call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingHomog: h5pcreate_f') ! call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingHomog: h5pset_dxpl_mpio_f') !#endif !!-------------------------------------------------------------------------------------------------- ! ! write data by fields in the datatype. Fields order is not important. ! call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i)+mpiOffset,int([dataspace_size(i)],HSIZE_T),& ! hdferr, file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingHomog: h5dwrite_f instance_id') !!-------------------------------------------------------------------------------------------------- ! !close types, dataspaces ! call h5tclose_f(dtype_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingHomog: h5tclose_f dtype_id') ! call h5tclose_f(position_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingHomog: h5tclose_f position_id') ! call h5dclose_f(dset_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingHomog: h5dclose_f') ! call h5sclose_f(space_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingHomog: h5sclose_f space_id') ! call h5sclose_f(memspace, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingHomog: h5sclose_f memspace') ! call h5pclose_f(plist_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_backwardMappingHomog: h5pclose_f') ! call HDF5_closeGroup(mapping_ID) ! enddo !end subroutine HDF5_backwardMappingHomog !!-------------------------------------------------------------------------------------------------- !!> @brief adds the unique cell to node mapping !!-------------------------------------------------------------------------------------------------- !subroutine HDF5_mappingCells(mapping) ! integer(pInt), intent(in), dimension(:) :: mapping ! integer :: hdferr, Nnodes ! integer(HID_T) :: mapping_id, dset_id, space_id ! Nnodes=size(mapping) ! mapping_ID = results_openGroup("mapping") !!-------------------------------------------------------------------------------------------------- !! create dataspace ! call h5screate_simple_f(1, int([Nnodes],HSIZE_T), space_id, hdferr, & ! int([Nnodes],HSIZE_T)) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_mappingCells: h5screate_simple_f') !!-------------------------------------------------------------------------------------------------- !! create Dataset ! call h5dcreate_f(mapping_id, "Cell",H5T_NATIVE_INTEGER, space_id, dset_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_mappingCells') !!-------------------------------------------------------------------------------------------------- !! write data by fields in the datatype. Fields order is not important. ! call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, mapping, int([Nnodes],HSIZE_T), hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_mappingCells: h5dwrite_f instance_id') !!-------------------------------------------------------------------------------------------------- !!close types, dataspaces ! call h5dclose_f(dset_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_mappingConstitutive: h5dclose_f') ! call h5sclose_f(space_id, hdferr) ! if (hdferr < 0) call IO_error(1,ext_msg='IO_mappingConstitutive: h5sclose_f') ! call HDF5_closeGroup(mapping_ID) !end subroutine HDF5_mappingCells end module results