diff --git a/code/IO.f90 b/code/IO.f90 index c4c10268c..56768e9b4 100644 --- a/code/IO.f90 +++ b/code/IO.f90 @@ -100,6 +100,7 @@ module IO #endif #ifdef HDF public:: HDF5_mappingConstitutive, & + HDF5_mappingHomogenization, & HDF5_closeJobFile #endif contains @@ -1906,9 +1907,8 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) end function abaqus_assembleInputFile #endif + #ifdef HDF - - !-------------------------------------------------------------------------------------------------- !> @brief creates and initializes HDF5 output file !-------------------------------------------------------------------------------------------------- @@ -2060,108 +2060,237 @@ subroutine HDF5_mappingConstitutive(mapping) ! create dataspace call h5screate_simple_f(2, int([Nconstituents,NmatPoints],HSIZE_T), space_id, hdf5err, & int([Nconstituents,NmatPoints],HSIZE_T)) - if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_addAttribute') + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive') !-------------------------------------------------------------------------------------------------- ! compound type call h5tcreate_f(H5T_COMPOUND_F, 6_SIZE_T, dtype_id, hdf5err) - if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_addAttribute: h5tcreate_f dtype_id') + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5tcreate_f dtype_id') + call h5tinsert_f(dtype_id, "Constitutive Instance", 0_SIZE_T, H5T_STD_U16LE, hdf5err) - if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_addAttribute: h5tinsert_f 0') + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5tinsert_f 0') call h5tinsert_f(dtype_id, "Position in Instance Results", 2_SIZE_T, H5T_STD_U32LE, hdf5err) - if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_addAttribute: h5tinsert_f 2') + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5tinsert_f 2') !-------------------------------------------------------------------------------------------------- ! create Dataset call h5dcreate_f(mapping_id, "Constitutive", dtype_id, space_id, dset_id, hdf5err) - if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_addAttribute') + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive') !-------------------------------------------------------------------------------------------------- ! Create memory types (one compound datatype for each member) call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), instance_id, hdf5err) - if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_addAttribute: h5tcreate_f instance_id') + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5tcreate_f instance_id') call h5tinsert_f(instance_id, "Constitutive Instance", 0_SIZE_T, H5T_NATIVE_INTEGER, hdf5err) - if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_addAttribute: h5tinsert_f instance_id') + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5tinsert_f instance_id') + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdf5err) - if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_addAttribute: h5tcreate_f position_id') + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5tcreate_f position_id') call h5tinsert_f(position_id, "Position in Instance Results", 0_SIZE_T, H5T_NATIVE_INTEGER, hdf5err) - if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_addAttribute: h5tinsert_f position_id') -print*, mapping -print*, 'ddddddddd' -print*, mapping(1:Nconstituents,1:nmatpoints,1) -print*, mapping(1:Nconstituents,1:nmatpoints,2) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5tinsert_f position_id') !-------------------------------------------------------------------------------------------------- ! write data by fields in the datatype. Fields order is not important. call h5dwrite_f(dset_id, position_id, mapping(1:Nconstituents,1:NmatPoints,1), & int([Nconstituents, NmatPoints],HSIZE_T), hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5dwrite_f position_id') call h5dwrite_f(dset_id, instance_id, mapping(1:Nconstituents,1:NmatPoints,2), & int([Nconstituents, NmatPoints],HSIZE_T), hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5dwrite_f instance_id') !-------------------------------------------------------------------------------------------------- !close types, dataspaces call h5tclose_f(dtype_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5tclose_f dtype_id') call h5tclose_f(position_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5tclose_f position_id') call h5tclose_f(instance_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5tclose_f instance_id') call h5dclose_f(dset_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5dclose_f') call h5sclose_f(space_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5sclose_f') call HDF5_closeGroup(mapping_ID) end subroutine HDF5_mappingConstitutive -subroutine HDF5_mappingHomogenization(Npoints) +!-------------------------------------------------------------------------------------------------- +!> @brief adds the unique mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_mappingCrystallite(mapping) use hdf5 implicit none - integer(pInt), intent(in) :: Npoints - integer(pInt) :: i - integer :: hdf5err - integer(HID_T) :: mapping_ID,dspace_id,dtype_id,dset_ID - INTEGER(HID_T) :: instance_id,position_id,elem_id,ip_id + integer(pInt), intent(in), dimension(:,:,:) :: mapping - mapping_ID=HDF5_openGroup("mapping") - call h5screate_simple_f(1, [int(Npoints,HSIZE_T)], dspace_id, hdf5err) ! dataspace + integer :: hdf5err, NmatPoints,Nconstituents + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id,instance_id,position_id + Nconstituents=size(mapping,1) + NmatPoints=size(mapping,2) + mapping_ID = HDF5_openGroup("mapping") + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(2, int([Nconstituents,NmatPoints],HSIZE_T), space_id, hdf5err, & + int([Nconstituents,NmatPoints],HSIZE_T)) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite') + +!-------------------------------------------------------------------------------------------------- ! compound type - CALL h5tcreate_f(H5T_COMPOUND_F, 11_SIZE_T, dtype_id, hdf5err) - CALL h5tinsert_f(dtype_id, "Homogenization Instance", 0_SIZE_T, H5T_STD_U16LE, hdf5err) - CALL h5tinsert_f(dtype_id, "Position in Instance", 2_SIZE_T, H5T_STD_U32LE, hdf5err) - CALL h5tinsert_f(dtype_id, "Element ID", 6_SIZE_T, H5T_STD_U32LE, hdf5err) - CALL h5tinsert_f(dtype_id, "Integration Point Number",10_SIZE_T, H5T_STD_U8LE, hdf5err) + call h5tcreate_f(H5T_COMPOUND_F, 6_SIZE_T, dtype_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Crystallite Instance", 0_SIZE_T, H5T_STD_U16LE, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f 0') + call h5tinsert_f(dtype_id, "Position in Instance Results", 2_SIZE_T, H5T_STD_U32LE, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f 2') + +!-------------------------------------------------------------------------------------------------- ! create Dataset - CALL h5dcreate_f(mapping_id, "Homogenization", dtype_id, dspace_id, dset_id, hdf5err) ! dataset + call h5dcreate_f(mapping_id, "Crystallite", dtype_id, space_id, dset_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite') - ! Create memory types. We have to create a compound datatype - ! for each member we want to write. - ! - CALL h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), instance_id, hdf5err) - CALL h5tinsert_f(instance_id, "Homogenization Instance", 0_SIZE_T, H5T_NATIVE_INTEGER, hdf5err) - CALL h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdf5err) - CALL h5tinsert_f(position_id, "Position in Instance", 0_SIZE_T, H5T_NATIVE_INTEGER, hdf5err) - CALL h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), elem_id, hdf5err) - CALL h5tinsert_f(elem_id, "Element Number", 0_SIZE_T, H5T_NATIVE_INTEGER, hdf5err) - CALL h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), ip_id, hdf5err) - CALL h5tinsert_f(ip_id, "Integration Point Number",0_SIZE_T, H5T_NATIVE_INTEGER, hdf5err) +!-------------------------------------------------------------------------------------------------- +! Create memory types (one compound datatype for each member) + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), instance_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tcreate_f instance_id') + call h5tinsert_f(instance_id, "Crystallite Instance", 0_SIZE_T, H5T_NATIVE_INTEGER, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f instance_id') - ! Write data by fields in the datatype. Fields order is not important. - ! - CALL h5dwrite_f(dset_id, ip_id, spread(1_pInt,1,Npoints), [int(Npoints,HSIZE_T)], hdf5err) - CALL h5dwrite_f(dset_id, position_id, [(i,i=0_pInt,Npoints-1_pInt)], [int(Npoints,HSIZE_T)], hdf5err) - CALL h5dwrite_f(dset_id, instance_id, spread(1_pInt,1,Npoints), [int(Npoints,HSIZE_T)], hdf5err) - CALL h5dwrite_f(dset_id, elem_id, [(i,i=1_pInt,Npoints)], [int(Npoints,HSIZE_T)], hdf5err) + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tcreate_f position_id') + call h5tinsert_f(position_id, "Position in Instance Results", 0_SIZE_T, H5T_NATIVE_INTEGER, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f position_id') -!close - call h5tclose_f(ip_id, hdf5err) - call h5tclose_f(elem_id, hdf5err) - call h5tclose_f(position_id, hdf5err) - call h5tclose_f(instance_id, hdf5err) +!-------------------------------------------------------------------------------------------------- +! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, position_id, mapping(1:Nconstituents,1:NmatPoints,1), & + int([Nconstituents, NmatPoints],HSIZE_T), hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dwrite_f position_id') + + call h5dwrite_f(dset_id, instance_id, mapping(1:Nconstituents,1:NmatPoints,2), & + int([Nconstituents, NmatPoints],HSIZE_T), hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces call h5tclose_f(dtype_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f dtype_id') + call h5tclose_f(position_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f position_id') + call h5tclose_f(instance_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f instance_id') call h5dclose_f(dset_id, hdf5err) - call h5sclose_f(dspace_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dclose_f') + call h5sclose_f(space_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5sclose_f') + call HDF5_closeGroup(mapping_ID) + +end subroutine HDF5_mappingCrystallite + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the unique mapping from spatial position to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_mappingHomogenization(mapping) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:,:) :: mapping + + integer :: hdf5err, NmatPoints + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id,instance_id,position_id,elem_id,ip_id + + NmatPoints=size(mapping,1) + mapping_ID = HDF5_openGroup("mapping") + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(2, int([NmatPoints],HSIZE_T), space_id, hdf5err, & + int([NmatPoints],HSIZE_T)) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization') + +!-------------------------------------------------------------------------------------------------- +! compound type + call h5tcreate_f(H5T_COMPOUND_F, 11_SIZE_T, dtype_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Homogenization Instance", 0_SIZE_T, H5T_STD_U16LE, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5tinsert_f 0') + call h5tinsert_f(dtype_id, "Position in Instance Results", 2_SIZE_T, H5T_STD_U32LE, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5tinsert_f 2') + call h5tinsert_f(dtype_id, "Element Number", 6_SIZE_T, H5T_STD_U32LE, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5tinsert_f 6') + call h5tinsert_f(dtype_id, "Material Point Number", 10_SIZE_T, H5T_STD_U8LE, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5tinsert_f 10') + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(mapping_id, "Homogenization", dtype_id, space_id, dset_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_addAttribute') + +!-------------------------------------------------------------------------------------------------- +! Create memory types (one compound datatype for each member) + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), instance_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5tcreate_f instance_id') + call h5tinsert_f(instance_id, "Homogenization Instance", 0_SIZE_T, H5T_NATIVE_INTEGER, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5tinsert_f instance_id') + + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5tcreate_f position_id') + call h5tinsert_f(position_id, "Position in Instance Results", 0_SIZE_T, H5T_NATIVE_INTEGER, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5tinsert_f position_id') + + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), elem_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5tcreate_f elem_id') + call h5tinsert_f(elem_id, "Element Number", 0_SIZE_T, H5T_NATIVE_INTEGER, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5tinsert_f elem_id') + + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), ip_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5tcreate_f ip_id') + call h5tinsert_f(ip_id, "Material Point Number", 0_SIZE_T, H5T_NATIVE_INTEGER, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5tinsert_f ip_id') + +!-------------------------------------------------------------------------------------------------- +! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, position_id, mapping(1:NmatPoints,1), & + int([NmatPoints],HSIZE_T), hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5dwrite_f position_id') + + call h5dwrite_f(dset_id, instance_id, mapping(1:NmatPoints,2), & + int([NmatPoints],HSIZE_T), hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5dwrite_f position_id') + + call h5dwrite_f(dset_id, elem_id, mapping(1:NmatPoints,3), & + int([NmatPoints],HSIZE_T), hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5dwrite_f elem_id') + + call h5dwrite_f(dset_id, ip_id, mapping(1:NmatPoints,4), & + int([NmatPoints],HSIZE_T), hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5dwrite_f ip_id') + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5tclose_f(dtype_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5tclose_f dtype_id') + call h5tclose_f(position_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5tclose_f position_id') + call h5tclose_f(instance_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5tclose_f instance_id') + call h5tclose_f(ip_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5tclose_f ip_id') + call h5tclose_f(elem_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5tclose_f elem_id') + call h5dclose_f(dset_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5dclose_f') + call h5sclose_f(space_id, hdf5err) + if (hdf5err < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomogenization: h5sclose_f') call HDF5_closeGroup(mapping_ID) end subroutine HDF5_mappingHomogenization + #endif end module IO diff --git a/code/constitutive.f90 b/code/constitutive.f90 index 9143c3b99..14ae66128 100644 --- a/code/constitutive.f90 +++ b/code/constitutive.f90 @@ -80,8 +80,7 @@ subroutine constitutive_init use hdf5, only: & HID_T use IO, only : & - HDF5_mappingConstitutive, & - HDF5_closeJobFile + HDF5_mappingConstitutive #endif use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) @@ -155,10 +154,14 @@ subroutine constitutive_init character(len=32) :: outputName !< name of output, intermediate fix until HDF5 output is ready logical :: knownPlasticity, nonlocalConstitutionPresent #ifdef HDF - integer(pInt), dimension(:,:,:), allocatable :: mapping - integer(pInt), dimension(:), allocatable :: InstancePosition - allocate(mapping(homogenization_maxngrains,mesh_ncpelems,2),source=0_pInt) - allocate(InstancePosition(material_nphase),source=0_pInt) + integer(pInt), dimension(:,:,:), allocatable :: mappingConstitutive + integer(pInt), dimension(:,:,:), allocatable :: mappingCrystallite + integer(pInt), dimension(:), allocatable :: ConstitutivePosition + integer(pInt), dimension(:), allocatable :: CrystallitePosition + allocate(mappingConstitutive(homogenization_maxngrains,mesh_ncpelems,2),source=0_pInt) + allocate(mappingCrystallite (homogenization_maxngrains,mesh_ncpelems,2),source=0_pInt) + allocate(ConstitutivePosition(material_nphase),source=0_pInt) + allocate(CrystallitePosition(material_nphase),source=0_pInt) #endif nonlocalConstitutionPresent = .false. @@ -444,7 +447,6 @@ subroutine constitutive_init enddo #ifdef HDF call HDF5_mappingConstitutive(mapping) - call HDF5_closeJobFile() #endif !-------------------------------------------------------------------------------------------------- ! write out state size file diff --git a/code/homogenization.f90 b/code/homogenization.f90 index dd2f1450a..99ab9eafd 100644 --- a/code/homogenization.f90 +++ b/code/homogenization.f90 @@ -92,6 +92,13 @@ contains !> @brief module initialization !-------------------------------------------------------------------------------------------------- subroutine homogenization_init() +#ifdef HDF + use hdf5, only: & + HID_T + use IO, only : & + HDF5_mappingHomogenization, & + HDF5_closeJobFile +#endif use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) use math, only: & math_I3 @@ -129,7 +136,12 @@ subroutine homogenization_init() character(len=64), dimension(:,:), pointer :: thisOutput character(len=32) :: outputName !< name of output, intermediate fix until HDF5 output is ready logical :: knownHomogenization - +#ifdef HDF + integer(pInt), dimension(:,:), allocatable :: mapping + integer(pInt), dimension(:), allocatable :: InstancePosition + allocate(mapping(mesh_ncpelems,4),source=0_pInt) + allocate(InstancePosition(material_Nhomogenization),source=0_pInt) +#endif !-------------------------------------------------------------------------------------------------- ! parse homogenization from config file if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... @@ -195,6 +207,10 @@ subroutine homogenization_init() elementLooping: do e = 1,mesh_NcpElems myInstance = homogenization_typeInstance(mesh_element(3,e)) IpLooping: do i = 1,FE_Nips(FE_geomtype(mesh_element(2,e))) +#ifdef HDF + InstancePosition(myInstance) = InstancePosition(myInstance)+1_pInt + mapping(e,1:4) = [instancePosition(myinstance),myinstance,e,i] +#endif select case(homogenization_type(mesh_element(3,e))) case (HOMOGENIZATION_ISOSTRAIN_ID) if (homogenization_isostrain_sizeState(myInstance) > 0_pInt) then @@ -217,6 +233,10 @@ subroutine homogenization_init() end select enddo IpLooping enddo elementLooping +#ifdef HDF + call HDF5_mappingHomogenization(mapping) + call HDF5_closeJobFile() +#endif !-------------------------------------------------------------------------------------------------- ! write state size file out diff --git a/configure b/configure index c50ad145a..3b9743d7d 100755 --- a/configure +++ b/configure @@ -91,17 +91,17 @@ parser.add_option('--prefix', dest='prefix', type='string', metav help='location of (links to) DAMASK executables [%default]') parser.add_option('--with-fc', dest='compiler', type='string', metavar='string', help='F90 compiler [%default]') -parser.add_option('--with-fftw-dir', dest='fftwRoot', type='string', metavar='string', +parser.add_option('--with-FFTW-dir', dest='fftwRoot', type='string', metavar='string', help='root directory of FFTW [%default]') -parser.add_option('--with-msc-dir', dest='mscRoot', type='string', metavar='string', +parser.add_option('--with-MSC-dir', dest='mscRoot', type='string', metavar='string', help='root directory of MSC.Marc/Mentat [%default]') parser.add_option('--with-HDF5-dir', dest='hdf5Root', type='string', metavar='string', help='root directory of HDF5 [%default]') parser.add_option('--with-OMP-threads', dest='threads', type='int', metavar='int', help='number of openMP threads [%default]') -parser.add_option('--with-blas-type', dest='blasType', type='string', metavar='string', +parser.add_option('--with-BLAS-type', dest='blasType', type='string', metavar='string', help='type of BLAS/LAPACK library [%default]') -parser.add_option('--with-blas-dir', dest='blasRoot', type='string', metavar='string', +parser.add_option('--with-BLAS-dir', dest='blasRoot', type='string', metavar='string', help='root directory of BLAS/LAPACK library [%default]') parser.add_option('--with-spectral-options', dest='spectraloptions', type='string', action='extend', metavar='', help='options for compilation of spectral solver')