From bb73a08cf4c39a7c6d1e604e0c2f7170d89efc13 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 24 Nov 2019 07:26:21 +0100 Subject: [PATCH 1/9] better encapsulation for results operations, do not rely directly on HDF5 module --- src/discretization.f90 | 5 +---- src/mesh_marc.f90 | 4 +++- src/results.f90 | 14 ++++++++++++++ 3 files changed, 18 insertions(+), 5 deletions(-) diff --git a/src/discretization.f90 b/src/discretization.f90 index dfcad48a3..873148666 100644 --- a/src/discretization.f90 +++ b/src/discretization.f90 @@ -6,9 +6,6 @@ module discretization use prec use results -#if defined(PETSc) || defined(DAMASK_HDF5) - use HDF5_utilities -#endif implicit none private @@ -84,7 +81,7 @@ subroutine discretization_results #if defined(PETSc) || defined(DAMASK_HDF5) real(pReal), dimension(:,:), allocatable :: u - call HDF5_closeGroup(results_addGroup(trim('current/geometry'))) + call results_closeGroup(results_addGroup(trim('current/geometry'))) u = discretization_NodeCoords (1:3,:discretization_sharedNodesBeginn) & - discretization_NodeCoords0(1:3,:discretization_sharedNodesBeginn) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index e67d5e0d1..51b9465b3 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -119,15 +119,17 @@ subroutine mesh_init(ip,el) reshape(connectivity_cell,[elem%NcellNodesPerCell,elem%nIPs*nElems]),& node0_cell,ip_reshaped) +!-------------------------------------------------------------------------------------------------- +! geometry information required by the nonlocal CP model call geometry_plastic_nonlocal_setIPvolume(IPvolume(elem,node0_cell,connectivity_cell)) unscaledNormals = IPareaNormal(elem,nElems,connectivity_cell,node0_cell) call geometry_plastic_nonlocal_setIParea(norm2(unscaledNormals,1)) call geometry_plastic_nonlocal_setIPareaNormal(unscaledNormals/spread(norm2(unscaledNormals,1),1,3)) call geometry_plastic_nonlocal_results - end subroutine mesh_init + !-------------------------------------------------------------------------------------------------- !> @brief Writes all information needed for the DADF5 geometry !-------------------------------------------------------------------------------------------------- diff --git a/src/results.f90 b/src/results.f90 index 471f994d6..93355b6c4 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -50,6 +50,7 @@ module results results_addIncrement, & results_addGroup, & results_openGroup, & + results_closeGroup, & results_writeDataset, & results_setLink, & results_addAttribute, & @@ -120,6 +121,7 @@ subroutine results_addIncrement(inc,time) end subroutine results_addIncrement + !-------------------------------------------------------------------------------------------------- !> @brief open a group from the results file !-------------------------------------------------------------------------------------------------- @@ -144,6 +146,18 @@ integer(HID_T) function results_addGroup(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 !-------------------------------------------------------------------------------------------------- From a6a6519678bdc86524045771cbcac022e965873e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 24 Nov 2019 07:44:17 +0100 Subject: [PATCH 2/9] more local data handling --- src/CPFEM2.f90 | 2 +- src/geometry_plastic_nonlocal.f90 | 2 +- src/grid/DAMASK_grid.f90 | 9 +-------- src/mesh_grid.f90 | 9 +++++++++ 4 files changed, 12 insertions(+), 10 deletions(-) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 5e8aad95e..7123602f8 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -57,10 +57,10 @@ subroutine CPFEM_initAll call config_init call math_init call rotations_init - call mesh_init call lattice_init call HDF5_utilities_init call results_init + call mesh_init call material_init call constitutive_init call crystallite_init diff --git a/src/geometry_plastic_nonlocal.f90 b/src/geometry_plastic_nonlocal.f90 index 88634c245..408306b2b 100644 --- a/src/geometry_plastic_nonlocal.f90 +++ b/src/geometry_plastic_nonlocal.f90 @@ -122,7 +122,7 @@ subroutine geometry_plastic_nonlocal_results integer, dimension(:), allocatable :: shp -#if defined(DAMASK_HDF5) +#if defined(PETSc) || defined(DAMASK_HDF5) call results_openJobFile writeVolume: block diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index 24c9da274..e83cf3283 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -27,7 +27,6 @@ program DAMASK_spectral use grid_mech_FEM use grid_damage_spectral use grid_thermal_spectral - use HDF5_utilities use results use rotations @@ -319,15 +318,9 @@ program DAMASK_spectral enddo close(fileUnit) - call results_openJobFile - call HDF5_closeGroup(results_addGroup('geometry')) - call results_addAttribute('grid',grid,'geometry') - call results_addAttribute('size',geomSize,'geometry') - call results_closeJobFile - !-------------------------------------------------------------------------------------------------- ! doing initialization depending on active solvers - call Utilities_init() + call Utilities_init do field = 1, nActiveFields select case (loadCases(1)%ID(field)) case(FIELD_MECH_ID) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index d09e01793..2b337f047 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -14,6 +14,7 @@ module mesh_grid use IO use debug use numerics + use results use discretization use geometry_plastic_nonlocal use FEsolving @@ -99,6 +100,14 @@ subroutine mesh_init(ip,el) FEsolving_execElem = [1,product(myGrid)] ! parallel loop bounds set to comprise all elements allocate(FEsolving_execIP(2,product(myGrid)),source=1) ! parallel loop bounds set to comprise the only IP +!-------------------------------------------------------------------------------------------------- +! store geometry information for post processing + call results_openJobFile + call results_closeGroup(results_addGroup('geometry')) + call results_addAttribute('grid',grid,'geometry') + call results_addAttribute('size',geomSize,'geometry') + call results_closeJobFile + !-------------------------------------------------------------------------------------------------- ! geometry information required by the nonlocal CP model call geometry_plastic_nonlocal_setIPvolume(reshape([(product(mySize/real(myGrid,pReal)),j=1,product(myGrid))], & From 50b48b8bf7ecb7f75250c51d7550ae0d09c1e43b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 24 Nov 2019 07:48:55 +0100 Subject: [PATCH 3/9] IP neighbourhood deprecated trivial for grid and, hence, not written out. Test for marc/abaqus/mesh would make more sense --- .gitlab-ci.yml | 7 ------ src/crystallite.f90 | 52 ++------------------------------------------- src/mesh_marc.f90 | 2 +- 3 files changed, 3 insertions(+), 58 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 2ccb6f06d..47cb2810c 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -308,13 +308,6 @@ nonlocal_densityConservation: - master - release -Spectral_ipNeighborhood: - stage: grid - script: Spectral_ipNeighborhood/test.py - except: - - master - - release - RGC_DetectChanges: stage: grid script: RGC_DetectChanges/test.py diff --git a/src/crystallite.f90 b/src/crystallite.f90 index c35237b9d..ca6b737a2 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -22,10 +22,6 @@ module crystallite use discretization use lattice use plastic_nonlocal - use geometry_plastic_nonlocal, only: & - nIPneighbors => geometry_plastic_nonlocal_nIPneighbors, & - IPneighborhood => geometry_plastic_nonlocal_IPneighborhood - use HDF5_utilities use results implicit none @@ -90,21 +86,11 @@ module crystallite enum, bind(c) enumerator :: undefined_ID, & - phase_ID, & - texture_ID, & orientation_ID, & - grainrotation_ID, & defgrad_ID, & - fe_ID, & fp_ID, & - fi_ID, & - lp_ID, & - li_ID, & p_ID, & - s_ID, & - elasmatrix_ID, & - neighboringip_ID, & - neighboringelement_ID + elasmatrix_ID end enum integer(kind(undefined_ID)),dimension(:,:), allocatable :: & crystallite_outputID !< ID of each post result output @@ -279,36 +265,14 @@ subroutine crystallite_init do o = 1, size(str) crystallite_output(o,c) = str(o) outputName: select case(str(o)) - case ('phase') outputName - crystallite_outputID(o,c) = phase_ID - case ('texture') outputName - crystallite_outputID(o,c) = texture_ID case ('orientation') outputName crystallite_outputID(o,c) = orientation_ID - case ('grainrotation') outputName - crystallite_outputID(o,c) = grainrotation_ID case ('defgrad','f') outputName ! ToDo: no alias (f only) crystallite_outputID(o,c) = defgrad_ID - case ('fe') outputName - crystallite_outputID(o,c) = fe_ID case ('fp') outputName crystallite_outputID(o,c) = fp_ID - case ('fi') outputName - crystallite_outputID(o,c) = fi_ID - case ('lp') outputName - crystallite_outputID(o,c) = lp_ID - case ('li') outputName - crystallite_outputID(o,c) = li_ID case ('p','firstpiola','1stpiola') outputName ! ToDo: no alias (p only) crystallite_outputID(o,c) = p_ID - case ('s','tstar','secondpiola','2ndpiola') outputName ! ToDo: no alias (s only) - crystallite_outputID(o,c) = s_ID - case ('elasmatrix') outputName - crystallite_outputID(o,c) = elasmatrix_ID - case ('neighboringip') outputName ! ToDo: this is not a result, it is static. Should be written out by mesh - crystallite_outputID(o,c) = neighboringip_ID - case ('neighboringelement') outputName ! ToDo: this is not a result, it is static. Should be written out by mesh - crystallite_outputID(o,c) = neighboringelement_ID case default outputName call IO_error(105,ext_msg=trim(str(o))//' (Crystallite)') end select outputName @@ -335,8 +299,6 @@ subroutine crystallite_init mySize = 4 case(defgrad_ID,fp_ID,p_ID) mySize = 9 - case(neighboringip_ID,neighboringelement_ID) - mySize = nIPneighbors case default mySize = 0 end select @@ -908,16 +870,6 @@ function crystallite_postResults(ipc, ip, el) mySize = 9 crystallite_postResults(c+1:c+mySize) = & reshape(transpose(crystallite_P(1:3,1:3,ipc,ip,el)),[mySize]) - case(neighboringelement_ID) - mySize = nIPneighbors - crystallite_postResults(c+1:c+mySize) = 0.0_pReal - forall (n = 1:mySize) & - crystallite_postResults(c+n) = real(IPneighborhood(1,n,ip,el),pReal) - case(neighboringip_ID) - mySize = nIPneighbors - crystallite_postResults(c+1:c+mySize) = 0.0_pReal - forall (n = 1:mySize) & - crystallite_postResults(c+n) = real(IPneighborhood(2,n,ip,el),pReal) end select c = c + mySize enddo @@ -945,7 +897,7 @@ subroutine crystallite_results do p=1,size(config_name_phase) group = trim('current/constituent')//'/'//trim(config_name_phase(p))//'/generic' - call HDF5_closeGroup(results_addGroup(group)) + call results_closeGroup(results_addGroup(group)) do o = 1, size(output_constituent(p)%label) select case (output_constituent(p)%label(o)) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 51b9465b3..f640baa72 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -69,7 +69,7 @@ subroutine mesh_init(ip,el) microstructureAt, & homogenizationAt integer:: & - Nnodes !< total number of nodes in mesh + Nnodes !< total number of nodes in mesh real(pReal), dimension(:,:), allocatable :: & ip_reshaped From e20477099e3429dbff74817952642ef352266d7b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 24 Nov 2019 09:46:46 +0100 Subject: [PATCH 4/9] no crystallite output --- src/crystallite.f90 | 106 ++--------------------------------------- src/homogenization.f90 | 4 +- 2 files changed, 5 insertions(+), 105 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index ca6b737a2..bbf92d40f 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -26,14 +26,6 @@ module crystallite implicit none private - character(len=64), dimension(:,:), allocatable :: & - crystallite_output !< name of each post result output - integer, public, protected :: & - crystallite_maxSizePostResults !< description not available - integer, dimension(:), allocatable, public, protected :: & - crystallite_sizePostResults !< description not available - integer, dimension(:,:), allocatable :: & - crystallite_sizePostResult !< description not available real(pReal), dimension(:,:,:), allocatable, public :: & crystallite_dt !< requested time increment of each grain @@ -199,13 +191,6 @@ subroutine crystallite_init allocate(crystallite_requested(cMax,iMax,eMax), source=.false.) allocate(crystallite_todo(cMax,iMax,eMax), source=.false.) allocate(crystallite_converged(cMax,iMax,eMax), source=.true.) - allocate(crystallite_output(maxval(crystallite_Noutput), & - size(config_crystallite))) ; crystallite_output = '' - allocate(crystallite_outputID(maxval(crystallite_Noutput), & - size(config_crystallite)), source=undefined_ID) - allocate(crystallite_sizePostResults(size(config_crystallite)),source=0) - allocate(crystallite_sizePostResult(maxval(crystallite_Noutput), & - size(config_crystallite)), source=0) num%subStepMinCryst = config_numerics%getFloat('substepmincryst', defaultVal=1.0e-3_pReal) num%subStepSizeCryst = config_numerics%getFloat('substepsizecryst', defaultVal=0.25_pReal) @@ -252,33 +237,6 @@ subroutine crystallite_init integrateState => integrateStateRKCK45 end select - - - do c = 1, size(config_crystallite) -#if defined(__GFORTRAN__) - str = ['GfortranBug86277'] - str = config_crystallite(c)%getStrings('(output)',defaultVal=str) - if (str(1) == 'GfortranBug86277') str = [character(len=65536)::] -#else - str = config_crystallite(c)%getStrings('(output)',defaultVal=[character(len=65536)::]) -#endif - do o = 1, size(str) - crystallite_output(o,c) = str(o) - outputName: select case(str(o)) - case ('orientation') outputName - crystallite_outputID(o,c) = orientation_ID - case ('defgrad','f') outputName ! ToDo: no alias (f only) - crystallite_outputID(o,c) = defgrad_ID - case ('fp') outputName - crystallite_outputID(o,c) = fp_ID - case ('p','firstpiola','1stpiola') outputName ! ToDo: no alias (p only) - crystallite_outputID(o,c) = p_ID - case default outputName - call IO_error(105,ext_msg=trim(str(o))//' (Crystallite)') - end select outputName - enddo - enddo - allocate(output_constituent(size(config_phase))) do c = 1, size(config_phase) #if defined(__GFORTRAN__) @@ -291,43 +249,13 @@ subroutine crystallite_init #endif enddo - - do r = 1,size(config_crystallite) - do o = 1,crystallite_Noutput(r) - select case(crystallite_outputID(o,r)) - case(orientation_ID) - mySize = 4 - case(defgrad_ID,fp_ID,p_ID) - mySize = 9 - case default - mySize = 0 - end select - crystallite_sizePostResult(o,r) = mySize - crystallite_sizePostResults(r) = crystallite_sizePostResults(r) + mySize - enddo - enddo - - crystallite_maxSizePostResults = & - maxval(crystallite_sizePostResults(microstructure_crystallite),microstructure_active) - - !-------------------------------------------------------------------------------------------------- ! write description file for crystallite output if (worldrank == 0) then call IO_write_jobFile(FILEUNIT,'outputCrystallite') - - do r = 1,size(config_crystallite) - if (any(microstructure_crystallite(discretization_microstructureAt) == r)) then - write(FILEUNIT,'(/,a,/)') '['//trim(config_name_crystallite(r))//']' - do o = 1,crystallite_Noutput(r) - write(FILEUNIT,'(a,i4)') trim(crystallite_output(o,r))//char(9),crystallite_sizePostResult(o,r) - enddo - endif - enddo - + write(FILEUNIT,'(/,a,/)') '[not supported anymore]' close(FILEUNIT) endif - call config_deallocate('material.config/phase') call config_deallocate('material.config/crystallite') @@ -831,49 +759,21 @@ function crystallite_postResults(ipc, ip, el) ip, & !< integration point index ipc !< grain index - real(pReal), dimension(1+crystallite_sizePostResults(microstructure_crystallite(discretization_microstructureAt(el))) + & + real(pReal), dimension(1+ & 1+plasticState(material_phaseAt(ipc,el))%sizePostResults + & sum(sourceState(material_phaseAt(ipc,el))%p(:)%sizePostResults)) :: & crystallite_postResults integer :: & o, & c, & - crystID, & mySize, & n - crystID = microstructure_crystallite(discretization_microstructureAt(el)) crystallite_postResults = 0.0_pReal - crystallite_postResults(1) = real(crystallite_sizePostResults(crystID),pReal) ! header-like information (length) + crystallite_postResults(1) = 0.0_pReal ! header-like information (length) c = 1 - do o = 1,crystallite_Noutput(crystID) - mySize = 0 - select case(crystallite_outputID(o,crystID)) - case (orientation_ID) - mySize = 4 - crystallite_postResults(c+1:c+mySize) = crystallite_orientation(ipc,ip,el)%asQuaternion() - -! remark: tensor output is of the form 11,12,13, 21,22,23, 31,32,33 -! thus row index i is slow, while column index j is fast. reminder: "row is slow" - - case (defgrad_ID) - mySize = 9 - crystallite_postResults(c+1:c+mySize) = & - reshape(transpose(crystallite_partionedF(1:3,1:3,ipc,ip,el)),[mySize]) - case (fp_ID) - mySize = 9 - crystallite_postResults(c+1:c+mySize) = & - reshape(transpose(crystallite_Fp(1:3,1:3,ipc,ip,el)),[mySize]) - case (p_ID) - mySize = 9 - crystallite_postResults(c+1:c+mySize) = & - reshape(transpose(crystallite_P(1:3,1:3,ipc,ip,el)),[mySize]) - end select - c = c + mySize - enddo - crystallite_postResults(c+1) = real(plasticState(material_phaseAt(ipc,el))%sizePostResults,pReal) ! size of constitutive results c = c + 1 if (size(crystallite_postResults)-c > 0) & diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 64edf95cc..cf0455d4f 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -262,7 +262,7 @@ subroutine homogenization_init materialpoint_sizeResults = 1 & ! grain count + 1 + thermal_maxSizePostResults & + damage_maxSizePostResults & - + homogenization_maxNgrains * (1 + crystallite_maxSizePostResults & ! crystallite size & crystallite results + + homogenization_maxNgrains * (1 & ! crystallite size + 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results + constitutive_source_maxSizePostResults) allocate(materialpoint_results(materialpoint_sizeResults,discretization_nIP,discretization_nElem)) @@ -618,7 +618,7 @@ subroutine materialpoint_postResults thePos = thePos + 1 grainLooping :do g = 1,myNgrains - theSize = 1 + crystallite_sizePostResults(myCrystallite) + & + theSize = 1 + & 1 + plasticState (material_phaseAt(g,e))%sizePostResults + & sum(sourceState(material_phaseAt(g,e))%p(:)%sizePostResults) materialpoint_results(thePos+1:thePos+theSize,i,e) = crystallite_postResults(g,i,e) ! tell crystallite results From 97474e05a86882aa2bfc4a325a7291aaadc5f717 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 24 Nov 2019 11:00:47 +0100 Subject: [PATCH 5/9] not needed anymore --- .../Polycrystal/material.config | 12 -------- src/config.f90 | 30 ++++++++----------- src/crystallite.f90 | 1 - src/material.f90 | 19 ------------ 4 files changed, 13 insertions(+), 49 deletions(-) diff --git a/examples/SpectralMethod/Polycrystal/material.config b/examples/SpectralMethod/Polycrystal/material.config index 4570941aa..e47c2142c 100644 --- a/examples/SpectralMethod/Polycrystal/material.config +++ b/examples/SpectralMethod/Polycrystal/material.config @@ -5,18 +5,6 @@ [SX] mech none -#-------------------# - -#-------------------# -[almostAll] -(output) orientation # quaternion -(output) grainrotation # deviation from initial orientation as axis (1-3) and angle in degree (4) -(output) F # deformation gradient tensor -(output) Fe # elastic deformation gradient tensor -(output) Fp # plastic deformation gradient tensor -(output) P # first Piola-Kichhoff stress tensor -(output) Lp # plastic velocity gradient tensor - #-------------------# #-------------------# diff --git a/src/config.f90 b/src/config.f90 index e66b85d2d..00b473767 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -85,6 +85,7 @@ subroutine config_init case (trim('crystallite')) call parse_materialConfig(config_name_crystallite,config_crystallite,line,fileContent(i+1:)) if (verbose) write(6,'(a)') ' Crystallite parsed'; flush(6) + deallocate(config_crystallite) case (trim('homogenization')) call parse_materialConfig(config_name_homogenization,config_homogenization,line,fileContent(i+1:)) @@ -102,27 +103,25 @@ subroutine config_init call IO_error(160,ext_msg='') if (.not. allocated(config_microstructure) .or. size(config_microstructure) < 1) & call IO_error(160,ext_msg='') - if (.not. allocated(config_crystallite) .or. size(config_crystallite) < 1) & - call IO_error(160,ext_msg='') if (.not. allocated(config_phase) .or. size(config_phase) < 1) & call IO_error(160,ext_msg='') if (.not. allocated(config_texture) .or. size(config_texture) < 1) & call IO_error(160,ext_msg='') - inquire(file='numerics.config', exist=fileExists) - if (fileExists) then - write(6,'(/,a)') ' reading numerics.config'; flush(6) - fileContent = IO_read_ASCII('numerics.config') - call parse_debugAndNumericsConfig(config_numerics,fileContent) - endif + inquire(file='numerics.config', exist=fileExists) + if (fileExists) then + write(6,'(/,a)') ' reading numerics.config'; flush(6) + fileContent = IO_read_ASCII('numerics.config') + call parse_debugAndNumericsConfig(config_numerics,fileContent) + endif - inquire(file='debug.config', exist=fileExists) - if (fileExists) then - write(6,'(/,a)') ' reading debug.config'; flush(6) - fileContent = IO_read_ASCII('debug.config') - call parse_debugAndNumericsConfig(config_debug,fileContent) - endif + inquire(file='debug.config', exist=fileExists) + if (fileExists) then + write(6,'(/,a)') ' reading debug.config'; flush(6) + fileContent = IO_read_ASCII('debug.config') + call parse_debugAndNumericsConfig(config_debug,fileContent) + endif contains @@ -295,9 +294,6 @@ subroutine config_deallocate(what) case('material.config/microstructure') deallocate(config_microstructure) - case('material.config/crystallite') - deallocate(config_crystallite) - case('material.config/homogenization') deallocate(config_homogenization) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index bbf92d40f..672bd2112 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -257,7 +257,6 @@ subroutine crystallite_init close(FILEUNIT) endif call config_deallocate('material.config/phase') - call config_deallocate('material.config/crystallite') !-------------------------------------------------------------------------------------------------- ! initialize diff --git a/src/material.f90 b/src/material.f90 index 2212fbe28..e86ba98e1 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -116,7 +116,6 @@ module material phase_Noutput, & !< number of '(output)' items per phase phase_elasticityInstance, & !< instance of particular elasticity of each phase phase_plasticityInstance, & !< instance of particular plasticity of each phase - crystallite_Noutput, & !< number of '(output)' items per crystallite setting homogenization_Ngrains, & !< number of grains in each homogenization homogenization_Noutput, & !< number of '(output)' items per homogenization homogenization_typeInstance, & !< instance of particular type of each homogenization @@ -245,9 +244,6 @@ subroutine material_init call material_parseMicrostructure() if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Microstructure parsed'; flush(6) - call material_parseCrystallite() - if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Crystallite parsed'; flush(6) - call material_parseHomogenization() if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Homogenization parsed'; flush(6) @@ -547,21 +543,6 @@ subroutine material_parseMicrostructure end subroutine material_parseMicrostructure -!-------------------------------------------------------------------------------------------------- -!> @brief parses the crystallite part in the material configuration file -!-------------------------------------------------------------------------------------------------- -subroutine material_parseCrystallite - - integer :: c - - allocate(crystallite_Noutput(size(config_crystallite)),source=0) - do c=1, size(config_crystallite) - crystallite_Noutput(c) = config_crystallite(c)%countKeys('(output)') - enddo - -end subroutine material_parseCrystallite - - !-------------------------------------------------------------------------------------------------- !> @brief parses the phase part in the material configuration file !-------------------------------------------------------------------------------------------------- From 406ca39b2c12f65dd154613c693ec1cfa5545fd2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 24 Nov 2019 21:23:43 +0100 Subject: [PATCH 6/9] ASCII table unable to handle inhomogeneous situations --- processing/post/DADF5_postResults.py | 50 ++++++++++++++-------------- processing/post/DADF5_vtk_cells.py | 1 - 2 files changed, 25 insertions(+), 26 deletions(-) diff --git a/processing/post/DADF5_postResults.py b/processing/post/DADF5_postResults.py index a16ef147c..88e4d777a 100755 --- a/processing/post/DADF5_postResults.py +++ b/processing/post/DADF5_postResults.py @@ -59,35 +59,35 @@ for filename in options.filenames: data = np.concatenate((data,coords),1) header+=' 1_pos 2_pos 3_pos' + results.set_visible('materialpoints',False) + results.set_visible('constituents', True) for label in options.con: - for p in results.iter_visible('con_physics'): - for c in results.iter_visible('constituents'): - x = results.get_dataset_location(label) - if len(x) == 0: - continue - array = results.read_dataset(x,0,plain=True) - d = int(np.product(np.shape(array)[1:])) - data = np.concatenate((data,np.reshape(array,[np.product(results.grid),d])),1) - - if d>1: - header+= ''.join([' {}_{}'.format(j+1,label) for j in range(d)]) - else: - header+=' '+label + x = results.get_dataset_location(label) + if len(x) == 0: + continue + array = results.read_dataset(x,0,plain=True) + d = np.product(np.shape(array)[1:]) + data = np.concatenate((data,np.reshape(array,[np.product(results.grid),d])),1) + if d>1: + header+= ''.join([' {}_{}'.format(j+1,label) for j in range(d)]) + else: + header+=' '+label + + results.set_visible('constituents', False) + results.set_visible('materialpoints',True) for label in options.mat: - for p in results.iter_visible('mat_physics'): - for m in results.iter_visible('materialpoints'): - x = results.get_dataset_location(label) - if len(x) == 0: - continue - array = results.read_dataset(x,0,plain=True) - d = int(np.product(np.shape(array)[1:])) - data = np.concatenate((data,np.reshape(array,[np.product(results.grid),d])),1) + x = results.get_dataset_location(label) + if len(x) == 0: + continue + array = results.read_dataset(x,0,plain=True) + d = np.product(np.shape(array)[1:]) + data = np.concatenate((data,np.reshape(array,[np.product(results.grid),d])),1) - if d>1: - header+= ''.join([' {}_{}'.format(j+1,label) for j in range(d)]) - else: - header+=' '+label + if d>1: + header+= ''.join([' {}_{}'.format(j+1,label) for j in range(d)]) + else: + header+=' '+label dirname = os.path.abspath(os.path.join(os.path.dirname(filename),options.dir)) if not os.path.isdir(dirname): diff --git a/processing/post/DADF5_vtk_cells.py b/processing/post/DADF5_vtk_cells.py index 1f5cc6686..9cd982e50 100755 --- a/processing/post/DADF5_vtk_cells.py +++ b/processing/post/DADF5_vtk_cells.py @@ -74,7 +74,6 @@ for filename in options.filenames: results.set_visible('materialpoints',False) results.set_visible('constituents', True) for label in options.con: - for p in results.iter_visible('con_physics'): if p != 'generic': for c in results.iter_visible('constituents'): From 67c8d3899d010718f44a82c439d7133104acb7d6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 25 Nov 2019 08:44:44 +0100 Subject: [PATCH 7/9] crystallite output fully removed --- PRIVATE | 2 +- examples/ConfigFiles/Crystallite_All.config | 9 --------- src/homogenization.f90 | 4 +--- src/material.f90 | 13 +++---------- 4 files changed, 5 insertions(+), 23 deletions(-) delete mode 100644 examples/ConfigFiles/Crystallite_All.config diff --git a/PRIVATE b/PRIVATE index a3a88933c..8fa92908b 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit a3a88933cbb92b81d481305ce93374917baf3980 +Subproject commit 8fa92908b841341395a8b13180bd6bcae2ad1659 diff --git a/examples/ConfigFiles/Crystallite_All.config b/examples/ConfigFiles/Crystallite_All.config deleted file mode 100644 index 2e9bafa73..000000000 --- a/examples/ConfigFiles/Crystallite_All.config +++ /dev/null @@ -1,9 +0,0 @@ -[all] -(output) orientation # quaternion -(output) grainrotation # deviation from initial orientation as axis (1-3) and angle in degree (4) in crystal reference coordinates -(output) F # deformation gradient tensor -(output) Fe # elastic deformation gradient tensor -(output) Fp # plastic deformation gradient tensor -(output) P # first Piola-Kichhoff stress tensor -(output) S # second Piola-Kichhoff stress tensor -(output) Lp # plastic velocity gradient tensor diff --git a/src/homogenization.f90 b/src/homogenization.f90 index cf0455d4f..a62f94820 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -592,15 +592,13 @@ subroutine materialpoint_postResults thePos, & theSize, & myNgrains, & - myCrystallite, & g, & !< grain number i, & !< integration point number e !< element number - !$OMP PARALLEL DO PRIVATE(myNgrains,myCrystallite,thePos,theSize) + !$OMP PARALLEL DO PRIVATE(myNgrains,thePos,theSize) elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2) myNgrains = homogenization_Ngrains(material_homogenizationAt(e)) - myCrystallite = microstructure_crystallite(discretization_microstructureAt(e)) IpLooping: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) thePos = 0 diff --git a/src/material.f90 b/src/material.f90 index e86ba98e1..2f70fe97b 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -120,8 +120,7 @@ module material homogenization_Noutput, & !< number of '(output)' items per homogenization homogenization_typeInstance, & !< instance of particular type of each homogenization thermal_typeInstance, & !< instance of particular type of each thermal transport - damage_typeInstance, & !< instance of particular type of each nonlocal damage - microstructure_crystallite !< crystallite setting ID of each microstructure ! DEPRECATED !!!! + damage_typeInstance !< instance of particular type of each nonlocal damage real(pReal), dimension(:), allocatable, public, protected :: & thermal_initialT, & !< initial temperature per each homogenization @@ -273,9 +272,6 @@ subroutine material_init allocate(temperatureRate (material_Nhomogenization)) do m = 1,size(config_microstructure) - if(microstructure_crystallite(m) < 1 .or. & - microstructure_crystallite(m) > size(config_crystallite)) & - call IO_error(150,m,ext_msg='crystallite') if(minval(microstructure_phase(1:microstructure_Nconstituents(m),m)) < 1 .or. & maxval(microstructure_phase(1:microstructure_Nconstituents(m),m)) > size(config_phase)) & call IO_error(150,m,ext_msg='phase') @@ -294,9 +290,8 @@ subroutine material_init enddo write(6,'(/,a14,18x,1x,a11,1x,a12,1x,a13)') 'microstructure','crystallite','constituents' do m = 1,size(config_microstructure) - write(6,'(1x,a32,1x,i11,1x,i12)') config_name_microstructure(m), & - microstructure_crystallite(m), & - microstructure_Nconstituents(m) + write(6,'(1x,a32,1x,i12)') config_name_microstructure(m), & + microstructure_Nconstituents(m) if (microstructure_Nconstituents(m) > 0) then do c = 1,microstructure_Nconstituents(m) write(6,'(a1,1x,a32,1x,a32,1x,f7.4)') '>',config_name_phase(microstructure_phase(c,m)),& @@ -496,7 +491,6 @@ subroutine material_parseMicrostructure character(len=65536) :: & tag - allocate(microstructure_crystallite(size(config_microstructure)), source=0) allocate(microstructure_Nconstituents(size(config_microstructure)), source=0) allocate(microstructure_active(size(config_microstructure)), source=.false.) @@ -508,7 +502,6 @@ subroutine material_parseMicrostructure do m=1, size(config_microstructure) microstructure_Nconstituents(m) = config_microstructure(m)%countKeys('(constituent)') - microstructure_crystallite(m) = config_microstructure(m)%getInt('crystallite') enddo microstructure_maxNconstituents = maxval(microstructure_Nconstituents) From 217a901edd5c6f69a8fca6a504f7247072b5717f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 25 Nov 2019 21:44:58 +0100 Subject: [PATCH 8/9] PRIVATE fixed --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 8fa92908b..66d562c75 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 8fa92908b841341395a8b13180bd6bcae2ad1659 +Subproject commit 66d562c755cd9aa4bbb8280c509383014acd52db From a4fdad78a4ae0548ad83e2e72efcf9fa7b909d65 Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 29 Nov 2019 19:04:38 +0100 Subject: [PATCH 9/9] [skip ci] updated version information after successful test of v2.0.3-1111-g374980da --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 1a1650364..6464fe0a4 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.3-1097-ga7fca4df +v2.0.3-1111-g374980da